home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 37 / IOPROG_37.ISO / SOFT / Multilizer.exe / disk1 / data1.cab / data1 / [Group9]VCL Source Standard / ivdictio.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-12  |  137.2 KB  |  5,189 lines
  1. { Copyrights 1995-1999 Innoview Data Technologies Ltd. }
  2.  
  3. unit IvDictio;
  4.  
  5. {$I IVMULTI.INC}
  6.  
  7. interface
  8.  
  9. uses
  10. {$IFDEF WIN32}
  11.   Windows,
  12. {$ELSE}
  13.   WinTypes, WinProcs,
  14. {$ENDIF}
  15.   SysUtils, Classes, Dialogs, Forms, Controls, Graphics, TypInfo, Menus,
  16.   IvCommon;
  17.  
  18. const
  19.   IV_SUB_SEPARATOR_C  = ',';
  20.  
  21.   TEST_MASK_C = $01;
  22.   PURE_ASCII_MASK_C = $02;
  23.  
  24.   { Code pages }
  25.  
  26.   THAI_CP_C = 874;
  27.   JAPANESE_CP_C = 932;
  28.   SIMPLIFIED_CHINESE_CP_C = 936;
  29.   KOREAN_CP_C = 949;
  30.   KOREAN_JOHAB_CP_C = 1361;
  31.   TRADITIONAL_CHINESE_CP_C = 950;
  32.   EAST_EUROPE_CP_C = 1250;
  33.   CYRILLIC_CP_C = 1251;
  34.   WESTERN_CP_C = 1252;
  35.   GREEK_CP_C = 1253;
  36.   TURKISH_CP_C = 1254;
  37.   HEBREW_CP_C = 1255;
  38.   ARABIC_CP_C = 1256;
  39.   BALTIC_CP_C = 1257;
  40.   VIETNAMESE_CP_C = 1258;
  41.  
  42.   LOCALE_ILCID = 0;
  43.  
  44.   LOCALE_IPRIMARYLANGUAGE = 1024;
  45.   LOCALE_ISUBLANGUAGE = 1025;
  46.   LOCALE_SWIN16LANGUAGENAME = 1026;
  47.   LOCALE_SWIN16COUNTRYNAME = 1027;
  48.   LOCALE_SISOLANGUAGE = 1028;
  49.   LOCALE_SISOCOUNTRY = 1029;
  50.  
  51.   LANG_USER   = -1;
  52.   LANG_SYSTEM = -2;
  53.  
  54.   SUBLANG_FINNISH        = $01;    { Finnish }
  55.   SUBLANG_FINNISH_SWEDEN = $02;    { Finnish (Sweden) }
  56.  
  57. {$IFDEF IVANSI}
  58.   { These were missing in Delphi 2.0's and C++Builder 1.0's Windows unit }
  59.  
  60.   LANG_ARABIC      = $01;
  61.   LANG_FARSI       = $29;
  62.   LANG_HEBREW      = $0d;
  63.   LANG_INDONESIAN  = $21;
  64.   LANG_SERBIAN     = $1a;
  65.   LANG_THAI        = $1e;
  66.   LANG_VIETNAMESE  = $2a;
  67.  
  68.   LANG_ALBANIAN    = $1c;
  69.   LANG_BELARUSIAN  = $23;
  70.   LANG_UKRAINIAN   = $22;
  71.   LANG_ESTONIAN    = $25;
  72.   LANG_LATVIAN     = $26;
  73.   LANG_LITHUANIAN  = $27;
  74.  
  75.   SUBLANG_ENGLISH_SOUTH_AFRICA         = $07;    { English (South Africa) }
  76.   SUBLANG_ENGLISH_JAMAICA              = $08;    { English (Jamaica) }
  77.   SUBLANG_ENGLISH_CARIBBEAN            = $09;    { English (Caribbean) }
  78.   SUBLANG_ENGLISH_BELIZE               = $0a;    { English (Belize) }
  79.   SUBLANG_ENGLISH_TRINIDAD             = $0b;    { English (Trinidad) }
  80.   SUBLANG_FRENCH_LUXEMBOURG            = $05;    { French (Luxembourg) }
  81.   SUBLANG_GERMAN_LUXEMBOURG            = $04;    { German (Luxembourg) }
  82.   SUBLANG_GERMAN_LIECHTENSTEIN         = $05;    { German (Liechtenstein) }
  83.   SUBLANG_KOREAN                       = $01;    { Korean (Extended Wansung) }
  84.   SUBLANG_KOREAN_JOHAB                 = $02;    { Korean (Johab) }
  85.   SUBLANG_SERBIAN_LATIN                = $02;
  86.   SUBLANG_SERBIAN_CYRILLIC             = $03;
  87.   SUBLANG_SPANISH_GUATEMALA            = $04;    { Spanish (Guatemala) }
  88.   SUBLANG_SPANISH_COSTA_RICA           = $05;    { Spanish (Costa Rica) }
  89.   SUBLANG_SPANISH_PANAMA               = $06;    { Spanish (Panama) }
  90.   SUBLANG_SPANISH_DOMINICAN_REPUBLIC   = $07;    { Spanish (Dominican Republic) }
  91.   SUBLANG_SPANISH_VENEZUELA            = $08;    { Spanish (Venezuela) }
  92.   SUBLANG_SPANISH_COLOMBIA             = $09;    { Spanish (Colombia) }
  93.   SUBLANG_SPANISH_PERU                 = $0a;    { Spanish (Peru) }
  94.   SUBLANG_SPANISH_ARGENTINA            = $0b;    { Spanish (Argentina) }
  95.   SUBLANG_SPANISH_ECUADOR              = $0c;    { Spanish (Ecuador) }
  96.   SUBLANG_SPANISH_CHILE                = $0d;    { Spanish (Chile) }
  97.   SUBLANG_SPANISH_URUGUAY              = $0e;    { Spanish (Uruguay) }
  98.   SUBLANG_SPANISH_PARAGUAY             = $0f;    { Spanish (Paraguay) }
  99.   SUBLANG_SPANISH_BOLIVIA              = $10;    { Spanish (Bolivia) }
  100.   SUBLANG_SPANISH_EL_SALVADOR          = $11;    { Spanish (El Salvador) }
  101.   SUBLANG_SPANISH_HONDURAS             = $12;    { Spanish (Honduras) }
  102.   SUBLANG_SPANISH_NICARAGUA            = $13;    { Spanish (Nicaragua) }
  103.   SUBLANG_SPANISH_PUERTO_RICO          = $14;    { Spanish (Puerto Rico) }
  104.   SUBLANG_SWEDISH                      = $01;    { Swedish }
  105.   SUBLANG_SWEDISH_FINLAND              = $02;    { Swedish (Finland) }
  106.  
  107.   VIETNAMESE_CHARSET = 163;
  108.  
  109.   LOCALE_ITIMEMARKPOSN        = $00001005; { time marker position }
  110.   LOCALE_IDEFAULTANSICODEPAGE = $00001004; { default ansi code page }
  111.   LOCALE_ICALENDARTYPE        = $00001009; { type of calendar specifier }
  112.   LOCALE_IOPTIONALCALENDAR    = $0000100B; { additional calendar types specifier }
  113.   LOCALE_IFIRSTDAYOFWEEK      = $0000100C; { first day of week specifier }
  114.   LOCALE_IFIRSTWEEKOFYEAR     = $0000100D; { first week of year specifier }
  115.   LOCALE_FONTSIGNATURE        = $00000058; { font signature }
  116.   LOCALE_SISO639LANGNAME      = $00000059;
  117.   LOCALE_SISO3166CTRYNAME     = $0000005A;
  118. {$ENDIF}
  119.  
  120. {$IFNDEF WIN32}
  121.   { Win16 doesn't have NLSAPI. Multilizer emulates it. }
  122.  
  123.   LANG_NEUTRAL     = $00;
  124.  
  125.   LANG_AFRIKAANS   = $36;
  126.   LANG_ARABIC      = $01;
  127.   LANG_ALBANIAN    = $1c;
  128.   LANG_BASQUE      = $2d;
  129.   LANG_BELARUSIAN  = $23;
  130.   LANG_BULGARIAN   = $02;
  131.   LANG_CATALAN     = $03;
  132.   LANG_CHINESE     = $04;
  133.   LANG_CROATIAN    = $1a;
  134.   LANG_CZECH       = $05;
  135.   LANG_DANISH      = $06;
  136.   LANG_DUTCH       = $13;
  137.   LANG_ENGLISH     = $09;
  138.   LANG_ESTONIAN    = $25;
  139.   LANG_FAEROESE    = $38;
  140.   LANG_FARSI       = $29;
  141.   LANG_FINNISH     = $0b;
  142.   LANG_FRENCH      = $0c;
  143.   LANG_GERMAN      = $07;
  144.   LANG_GREEK       = $08;
  145.   LANG_HEBREW      = $0d;
  146.   LANG_HUNGARIAN   = $0e;
  147.   LANG_ICELANDIC   = $0f;
  148.   LANG_INDONESIAN  = $21;
  149.   LANG_ITALIAN     = $10;
  150.   LANG_JAPANESE    = $11;
  151.   LANG_KOREAN      = $12;
  152.   LANG_LATVIAN     = $26;
  153.   LANG_LITHUANIAN  = $27;
  154.   LANG_NORWEGIAN   = $14;
  155.   LANG_POLISH      = $15;
  156.   LANG_PORTUGUESE  = $16;
  157.   LANG_ROMANIAN    = $18;
  158.   LANG_RUSSIAN     = $19;
  159.   LANG_SERBIAN     = $1a;
  160.   LANG_SLOVAK      = $1b;
  161.   LANG_SLOVENIAN   = $24;
  162.   LANG_SPANISH     = $0a;
  163.   LANG_SWEDISH     = $1d;
  164.   LANG_THAI        = $1e;
  165.   LANG_TURKISH     = $1f;
  166.   LANG_UKRAINIAN   = $22;
  167.   LANG_VIETNAMESE  = $2a;
  168.  
  169.   SUBLANG_NEUTRAL              = $00;    { language neutral }
  170.   SUBLANG_DEFAULT              = $01;    { user default }
  171.   SUBLANG_SYS_DEFAULT          = $02;    { system default }
  172.  
  173.   SUBLANG_CHINESE_TRADITIONAL          = $01;    { Chinese (Taiwan) }
  174.   SUBLANG_CHINESE_SIMPLIFIED           = $02;    { Chinese (PR China) }
  175.   SUBLANG_CHINESE_HONGKONG             = $03;    { Chinese (Hong Kong) }
  176.   SUBLANG_CHINESE_SINGAPORE            = $04;    { Chinese (Singapore) }
  177.   SUBLANG_DUTCH                        = $01;    { Dutch }
  178.   SUBLANG_DUTCH_BELGIAN                = $02;    { Dutch (Belgian) }
  179.   SUBLANG_ENGLISH_US                   = $01;    { English (USA) }
  180.   SUBLANG_ENGLISH_UK                   = $02;    { English (UK) }
  181.   SUBLANG_ENGLISH_AUS                  = $03;    { English (Australian) }
  182.   SUBLANG_ENGLISH_CAN                  = $04;    { English (Canadian) }
  183.   SUBLANG_ENGLISH_NZ                   = $05;    { English (New Zealand) }
  184.   SUBLANG_ENGLISH_EIRE                 = $06;    { English (Irish) }
  185.   SUBLANG_ENGLISH_SOUTH_AFRICA         = $07;    { English (South Africa) }
  186.   SUBLANG_ENGLISH_JAMAICA              = $08;    { English (Jamaica) }
  187.   SUBLANG_ENGLISH_CARIBBEAN            = $09;    { English (Caribbean) }
  188.   SUBLANG_ENGLISH_BELIZE               = $0a;    { English (Belize) }
  189.   SUBLANG_ENGLISH_TRINIDAD             = $0b;    { English (Trinidad) }
  190.   SUBLANG_FRENCH                       = $01;    { French }
  191.   SUBLANG_FRENCH_BELGIAN               = $02;    { French (Belgian) }
  192.   SUBLANG_FRENCH_CANADIAN              = $03;    { French (Canadian) }
  193.   SUBLANG_FRENCH_SWISS                 = $04;    { French (Swiss) }
  194.   SUBLANG_FRENCH_LUXEMBOURG            = $05;    { French (Luxembourg) }
  195.   SUBLANG_GERMAN                       = $01;    { German }
  196.   SUBLANG_GERMAN_SWISS                 = $02;    { German (Swiss) }
  197.   SUBLANG_GERMAN_AUSTRIAN              = $03;    { German (Austrian) }
  198.   SUBLANG_GERMAN_LUXEMBOURG            = $04;    { German (Luxembourg) }
  199.   SUBLANG_GERMAN_LIECHTENSTEIN         = $05;    { German (Liechtenstein) }
  200.   SUBLANG_ITALIAN                      = $01;    { Italian }
  201.   SUBLANG_ITALIAN_SWISS                = $02;    { Italian (Swiss) }
  202.   SUBLANG_KOREAN                       = $01;    { Korean (Extended Wansung) }
  203.   SUBLANG_KOREAN_JOHAB                 = $02;    { Korean (Johab) }
  204.   SUBLANG_NORWEGIAN_BOKMAL             = $01;    { Norwegian (Bokmal) }
  205.   SUBLANG_NORWEGIAN_NYNORSK            = $02;    { Norwegian (Nynorsk) }
  206.   SUBLANG_PORTUGUESE                   = $02;    { Portuguese }
  207.   SUBLANG_PORTUGUESE_BRAZILIAN         = $01;    { Portuguese (Brazilian) }
  208.   SUBLANG_SERBIAN_LATIN                = $02;    { Serbian (Latin) }
  209.   SUBLANG_SERBIAN_CYRILLIC             = $03;    { Serbian (Cyrillic) }
  210.   SUBLANG_SPANISH                      = $01;    { Spanish (Castilian) }
  211.   SUBLANG_SPANISH_MEXICAN              = $02;    { Spanish (Mexican) }
  212.   SUBLANG_SPANISH_MODERN               = $03;    { Spanish (Modern) }
  213.   SUBLANG_SPANISH_GUATEMALA            = $04;    { Spanish (Guatemala) }
  214.   SUBLANG_SPANISH_COSTA_RICA           = $05;    { Spanish (Costa Rica) }
  215.   SUBLANG_SPANISH_PANAMA               = $06;    { Spanish (Panama) }
  216.   SUBLANG_SPANISH_DOMINICAN_REPUBLIC   = $07;    { Spanish (Dominican Republic) }
  217.   SUBLANG_SPANISH_VENEZUELA            = $08;    { Spanish (Venezuela) }
  218.   SUBLANG_SPANISH_COLOMBIA             = $09;    { Spanish (Colombia) }
  219.   SUBLANG_SPANISH_PERU                 = $0a;    { Spanish (Peru) }
  220.   SUBLANG_SPANISH_ARGENTINA            = $0b;    { Spanish (Argentina) }
  221.   SUBLANG_SPANISH_ECUADOR              = $0c;    { Spanish (Ecuador) }
  222.   SUBLANG_SPANISH_CHILE                = $0d;    { Spanish (Chile) }
  223.   SUBLANG_SPANISH_URUGUAY              = $0e;    { Spanish (Uruguay) }
  224.   SUBLANG_SPANISH_PARAGUAY             = $0f;    { Spanish (Paraguay) }
  225.   SUBLANG_SPANISH_BOLIVIA              = $10;    { Spanish (Bolivia) }
  226.   SUBLANG_SPANISH_EL_SALVADOR          = $11;    { Spanish (El Salvador) }
  227.   SUBLANG_SPANISH_HONDURAS             = $12;    { Spanish (Honduras) }
  228.   SUBLANG_SPANISH_NICARAGUA            = $13;    { Spanish (Nicaragua) }
  229.   SUBLANG_SPANISH_PUERTO_RICO          = $14;    { Spanish (Puerto Rico) }
  230.   SUBLANG_SWEDISH                      = $01;    { Swedish }
  231.   SUBLANG_SWEDISH_FINLAND              = $02;    { Swedish (Finland) }
  232.  
  233.   SORT_DEFAULT = $0 ; { sorting default }
  234.   LOCALE_SENGLANGUAGE = 4097; { English name of language }
  235.   LOCALE_SNATIVELANGNAME = 4; { native name of language }
  236.   LOCALE_SENGCOUNTRY = 4098; { English name of country }
  237.   LOCALE_SNATIVECTRYNAME = 8; { native name of country }
  238.   LOCALE_IDEFAULTANSICODEPAGE = $00001004; { default ansi code page }
  239.   LOCALE_IMEASURE = 13; { 0 = metric, 1 = US }
  240.   LOCALE_SDECIMAL = 14; { decimal separator }
  241.   LOCALE_STHOUSAND = 15; { thousand separator }
  242.   LOCALE_SCURRENCY = 20; { local monetary symbol }
  243.   LOCALE_ICURRDIGITS = 25; { # local monetary digits }
  244.   LOCALE_ICURRENCY = 27; { positive currency mode }
  245.   LOCALE_INEGCURR = 28; { negative currency mode }
  246.   LOCALE_SDATE = 29; { date separator }
  247.   LOCALE_STIME = 30; { time separator }
  248.   LOCALE_SSHORTDATE = 31; { short date format string }
  249.   LOCALE_SLONGDATE = $20; { long date format string }
  250.   LOCALE_ITIME = 35; { time format specifier }
  251.   LOCALE_ITIMEMARKPOSN = $00001005; { time marker position }
  252.   LOCALE_ITLZERO = 37; { leading zeros in time field }
  253.   LOCALE_S1159 = 40; { AM designator }
  254.   LOCALE_S2359 = 41; { PM designator }
  255.   LOCALE_SDAYNAME1 = 42; { long name for Monday }
  256.   LOCALE_SDAYNAME7 = 48; { long name for Sunday }
  257.   LOCALE_SABBREVDAYNAME1 = 49; { abbreviated name for Monday }
  258.   LOCALE_SABBREVDAYNAME7 = 55; { abbreviated name for Sunday }
  259.   LOCALE_SMONTHNAME1 = 56; { long name for January }
  260.   LOCALE_SMONTHNAME12 = 67; { long name for December }
  261.   LOCALE_SABBREVMONTHNAME1 = 68; { abbreviated name for January }
  262.   LOCALE_SABBREVMONTHNAME12 = 79; { abbreviated name for December }
  263.   LOCALE_STIMEFORMAT = 4099; { time format string }
  264.   LOCALE_ICALENDARTYPE        = $00001009; { type of calendar specifier }
  265.   LOCALE_IOPTIONALCALENDAR    = $0000100B; { additional calendar types specifier }
  266.   LOCALE_IFIRSTDAYOFWEEK      = $0000100C; { first day of week specifier }
  267.   LOCALE_IFIRSTWEEKOFYEAR     = $0000100D; { first week of year specifier }
  268.   LOCALE_SISO639LANGNAME = $00000059;
  269.   LOCALE_SISO3166CTRYNAME = $0000005A;
  270.  
  271.   CAL_GREGORIAN = 1;     { Gregorian (localized) calendar }
  272.   CAL_GREGORIAN_US = 2;  { Gregorian (U.S.) calendar }
  273. {$ENDIF}
  274.  
  275. {$IFDEF WIN32}
  276.   {$IFDEF IVVB}
  277.   KEY_C = VB_KEY_C;
  278.   {$ELSE}
  279.     {$IFDEF VER90}
  280.   KEY_C = DELPHI2_KEY_C;
  281.     {$ELSE}
  282.       {$IFDEF VER100}
  283.   KEY_C = DELPHI3_KEY_C;
  284.       {$ELSE}
  285.         {$IFDEF VER93}
  286.   KEY_C = CBUILDER1_KEY_C;
  287.         {$ELSE}
  288.           {$IFDEF VER110}
  289.   KEY_C = CBUILDER3_KEY_C;
  290.           {$ELSE}
  291.             {$IFDEF VER120}
  292.   KEY_C = DELPHI4_KEY_C;
  293.             {$ELSE}
  294.               {$IFDEF VER125}
  295.   KEY_C = CBUILDER4_KEY_C;
  296.               {$ELSE}
  297.   KEY_C = DELPHI5_KEY_C;
  298.               {$ENDIF}
  299.             {$ENDIF}
  300.           {$ENDIF}
  301.         {$ENDIF}
  302.       {$ENDIF}
  303.     {$ENDIF}
  304.   {$ENDIF}
  305. {$ELSE}
  306.   KEY_C = '';
  307. {$ENDIF}
  308.  
  309. {$IFDEF IVVB}
  310.   SECTION_C = VB16_SECTION_C;
  311. {$ELSE}
  312.   SECTION_C = DELPHI1_SECTION_C;
  313. {$ENDIF}
  314.  
  315.   CONTEXT_SEPARATOR_C = #127;
  316.   EURO_CHAR_C = #128;
  317.  
  318. type
  319. {$IFDEF WIN32}
  320.   TIvString = AnsiString;
  321.   {$IFDEF IVWIDE}
  322.   TIvWideString = WideString;
  323.   {$ELSE}
  324.   TIvWideString = PWideChar;
  325.   {$ENDIF}
  326. {$ELSE}
  327.   TIvString = PChar;
  328. {$ENDIF}
  329.  
  330.   TIvByteOrder = (ivboBigEndian, ivboLittleEndian);
  331.   TIvCharacterSet = (ivcsUnicode, ivcsCodePage);
  332.  
  333.   TIvDialogPosition = (ivdpParent, ivdpCenter);
  334.   TIvDialogPositions = set of TIvDialogPosition;
  335.  
  336. {$IFDEF IVANSI}
  337.   { This was missing in Delphi 2.0's windows unit }
  338.  
  339.   TFontCharset = 0..255;
  340. {$ENDIF}
  341.  
  342. {$IFDEF WIN32}
  343.   PHLK = ^HKL;
  344.  
  345.   TIvCharsetInfo = record
  346.     charSet: TFontCharset;
  347.     codePage: Integer;
  348.   end;
  349.  
  350.   PLocaleFontSignature = ^TLocaleFontSignature;
  351.   TLocaleFontSignature = packed record
  352.     fsUsb: array[0..3] of DWORD;
  353.     fsCsbDefault: array[0..1] of DWORD;
  354.     fsCsbSupported: array[0..1] of DWORD;
  355.   end;
  356.  
  357.   TIvFontCharset = (ivcsDefault, ivcsOEM, ivcsSymbol, ivcsMac, ivcsAnsi,
  358.     ivcsEastEurope, ivcsBaltic, ivcsRussian, ivcsGreek, ivcsTurkish,
  359.     ivcsArabic, ivcsHebrew, ivcsShiftJIS, ivcsHangeul, ivcsJohab,
  360.     ivcsChineseBig5, ivcsGB2312, ivcsThai, ivcsVietnamese);
  361.   TIvFontCharsets = set of TIvFontCharset;
  362. {$ENDIF}
  363.  
  364.   { TIvPropInfoList }
  365.  
  366.   TIvPropInfoList = class
  367.   private
  368. {$IFDEF VER125}
  369.     FList: Pointer;
  370. {$ELSE}
  371.     FList: PPropList;
  372. {$ENDIF}
  373.     FCount: Integer;
  374.     FSize: Integer;
  375.  
  376.     function Get(Index: Integer): PPropInfo;
  377.  
  378.   public
  379.     constructor Create(obj: TObject; Filter: TTypeKinds);
  380.     destructor Destroy; override;
  381.  
  382.     property Count: Integer read FCount;
  383.     property Items[Index: Integer]: PPropInfo read Get; default;
  384.   end;
  385.  
  386.   { TIvLanguage }
  387.  
  388.   TIvLanguageOption = (ivloTest, ivloPureASCII);
  389.   TIvLanguageOptions = set of TIvLanguageOption;
  390.   TIvCharacterSetType = (ivcsSingleByte, ivcsMultiByte, ivcsBiDirectional);
  391.  
  392.   TIvDisplayName = (ivdnEnglish, ivdnNative, ivdnTranslated);
  393.  
  394.   TIvDictionary = class;
  395.  
  396.   TIvLanguage = class(TObject)
  397.   protected
  398.     FCodePage: Integer;
  399.     FPrimary: Integer;
  400.     FVariant: String;
  401.     FActiveSub: Integer;
  402.     FDefaultSub: Integer;
  403.     FSubs: TStringList;
  404.     FISOLanguage: String;
  405.     FISODefaultCountry: String;
  406.     FISOCountries: TStringList;
  407.     FEnglishName: String;
  408.     FNativeName: String;
  409.     FFontName: String;
  410.     FFontSize: Integer;
  411.     FOptions: TIvLanguageOptions;
  412. {$IFDEF WIN32}
  413.     FCharset: TFontCharset;
  414. {$ENDIF}
  415.  
  416.     function GetSub: Integer;
  417.     function GetSubCount: Integer;
  418.     function GetSubs(i: Integer): Integer;
  419.  
  420.     function GetAllSubs: String;
  421.     procedure SetAllSubs(const value: String);
  422.  
  423.     function GetISOCountry: String;
  424.     function GetISOCountryCount: Integer;
  425.     function GetISOCountries(i: Integer): String;
  426.  
  427.     function GetISOAllCountries: String;
  428.     procedure SetISOAllCountries(const value: String);
  429.  
  430.     function GetLocale: Integer;
  431.     function GetLangId: Integer;
  432.     function GetDefaultLocale: Integer;
  433.     function GetActiveLocale: Integer;
  434.     function GetCharsetType: TIvCharacterSetType;
  435.  
  436.     procedure SetActiveSub(value: Integer);
  437.  
  438.     procedure SetCodePage(value: Integer);
  439.  
  440.     function GetOptionsAsInt: Integer;
  441.     procedure SetOptionsAsInt(value: Integer);
  442.  
  443.   public
  444.     constructor Create;
  445.     constructor CreateValue(
  446.       primary, defaultSub, codePage: Integer;
  447.       const subs, englishName, nativeName, fontName: String;
  448.       fontSize: Integer;
  449.       options: TIvLanguageOptions);
  450.     destructor Destroy; override;
  451.  
  452.     procedure Assign(source: TIvLanguage); virtual;
  453.     function Copy: TIvLanguage; virtual;
  454.     procedure Init; virtual;
  455.  
  456.     function PrimaryEquals(language: TIvLanguage): Boolean; virtual;
  457.  
  458.     function GetBundleExtension: String;
  459.  
  460.     procedure ClearSubs;
  461.     procedure AddSub(sub: Integer);
  462.  
  463.     procedure ClearISOCountries;
  464.     procedure AddISOCountry(country: String);
  465.  
  466.     function GetDisplayName(
  467.       displayName: TIvDisplayName;
  468.       dictionary: TIvDictionary): String; virtual;
  469.  
  470.     class function SubStrToSubId(const str: String): Integer;
  471.  
  472.     property Sub: Integer read GetSub;
  473.     property SubCount: Integer read GetSubCount;
  474.     property Subs[i: Integer]: Integer read GetSubs;
  475.     property ISOCountry: String read GetISOCountry;
  476.     property ISOCountryCount: Integer read GetISOCountryCount;
  477.     property ISOCountries[i: Integer]: String read GetISOCountries;
  478. {$IFDEF IVVB}
  479.     property VBSubs: TStringList read FSubs;
  480.     property VBISOCountries: TStringList read FISOCountries;
  481. {$ENDIF}
  482.     property LangId: Integer read GetLangId;
  483.     property Locale: Integer read GetLocale;
  484.     property DefaultLocale: Integer read GetDefaultLocale;
  485.     property ActiveLocale: Integer read GetActiveLocale;
  486.     property CharsetType: TIvCharacterSetType read GetCharsetType;
  487.     property EnglishName: String read FEnglishName write FEnglishName;
  488.     property NativeName: String read FNativeName write FNativeName;
  489. {$IFDEF WIN32}
  490.     property Charset: TFontCharset read FCharset write FCharset;
  491. {$ENDIF}
  492.     property CodePage: Integer read FCodePage write SetCodePage;
  493.     property Primary: Integer read FPrimary write FPrimary;
  494.     property Variant: String read FVariant write FVariant;
  495.     property AllSubs: String read GetAllSubs write SetAllSubs;
  496.     property DefaultSub: Integer read FDefaultSub write FDefaultSub;
  497.     property ActiveSub: Integer read FActiveSub write SetActiveSub;
  498.     property ISOLanguage: String read FISOLanguage write FISOLanguage;
  499.     property ISOAllCountries: String read GetISOAllCountries write SetISOAllCountries;
  500.     property ISODefaultCountry: String read FISODefaultCountry write FISODefaultCountry;
  501.     property FontName: String read FFontName write FFontName;
  502.     property FontSize: Integer read FFontSize write FFontSize;
  503.     property Options: TIvLanguageOptions read FOptions write FOptions;
  504.     property OptionsAsInt: Integer read GetOptionsAsInt write SetOptionsAsInt;
  505.   end;
  506.  
  507.   { TIvLocale }
  508.  
  509.   TIvMeasurementSystem = (ivmsMetric, ivmsUS);
  510.  
  511.   TIvCurrencyFormat = (ivcfS1, ivcf1S, ivcfS_1, ivcf1_S);
  512.  
  513.   TIvNegativeCurrencyFormat = (ivncS1, ivncNS1, ivncSN1, ivncS1N, ivnc1S,
  514.     ivncN1S, ivnc1NS, ivnc1SN, ivncN1_S, ivncNS_1, ivnc1_SN, ivncS_1N,
  515.     ivncS_N1, ivnc1N_S, ivncS_1, ivnc1_S);
  516.  
  517.   TIvTimeFormat = (ivtf12, ivtf24);
  518.   TIvTimeMarkPosition = (ivtmSuffix, ivtmPrefix);
  519.  
  520.   TIvDayOfWeek = (ivwdMonday, ivwdTuesday, ivwdWednesday, ivwdThursday, ivwdFriday, ivwdSaturday, ivwdSunday);
  521.   TIvFirstWeekOfYear = (ivfwFirstPart, ivfwFirstFull, ivfwFirst4);
  522.  
  523.   TIvCalendarType = (ivctNone, ivctGregorian, ivctGregorianUS, ivctJapan,
  524.     ivctTaiwan, ivctKorea, ivctHijri, ivctThai, ivctHebrew);
  525.  
  526.   TIvEuro = (iveNormal, iveBusiness, iveIgnore);
  527.   TIvEMU = (iveNone, iveLocal, iveLocalAndEuro, iveEuroAndLocal, iveEuro);
  528.  
  529.   TIvLocale = class(TObject)
  530.   private
  531.     function GetLangId: Integer;
  532.     procedure SetLangId(value: Integer);
  533.  
  534.     function GetLocale: Integer;
  535.     procedure SetLocale(value: Integer);
  536.     function GetCharsetType: TIvCharacterSetType;
  537.     function GetEMU: TIvEMU;
  538.     function GetEMUCurrencyString: String;
  539.  
  540.   public
  541.     Primary: Integer;
  542.     Sub: Integer;
  543.     SortId: Integer;
  544.     ISOLanguage: String;
  545.     ISOCountry: String;
  546.     CodePage: Integer;
  547.     IsCustom: Boolean;
  548. {$IFDEF WIN32}
  549.     Charset: TFontCharset;
  550. {$ENDIF}
  551.  
  552.     EnglishLanguageName: String;
  553.     EnglishCountryName: String;
  554.     NativeLanguageName: String;
  555.     NativeCountryName: String;
  556.     Win16LanguageName: String;
  557.     Win16CountryName: String;
  558.  
  559.     CurrencyString: String;
  560.     CurrencyFormat: TIvCurrencyFormat;
  561.     NegCurrFormat: TIvNegativeCurrencyFormat;
  562.     CurrencyDecimals: Byte;
  563.  
  564.     ThousandSeparator: Char;
  565.     DecimalSeparator: Char;
  566.  
  567.     DateSeparator: Char;
  568.     ShortDateFormat: String;
  569.     LongDateFormat: String;
  570.  
  571.     TimeSeparator: Char;
  572.     TimeAMString: String;
  573.     TimePMString: String;
  574.     TimeLeadingZeros: Boolean;
  575.     TimeFormat: TIvTimeFormat;
  576.     TimeMarkPosition: TIvTimeMarkPosition;
  577.  
  578.     MeasurementSystem: TIvMeasurementSystem;
  579.     CalendarType: TIvCalendarType;
  580.     OptionalCalendarType: TIvCalendarType;
  581.     FirstDayOfWeek: TIvDayOfWeek;
  582.     FirstWeekOfYear: TIvFirstWeekOfYear;
  583.  
  584.     ShortMonthNames: array[1..12] of String;
  585.     LongMonthNames: array[1..12] of String;
  586.     ShortDayNames: array[1..7] of String;
  587.     LongDayNames: array[1..7] of String;
  588.  
  589.     procedure Assign(source: TIvLocale); virtual;
  590.     function Copy: TIvLocale; virtual;
  591.     procedure Init; virtual;
  592.  
  593.     function GetDisplayName(
  594.       displayName: TIvDisplayName;
  595.       dictionary: TIvDictionary): String; virtual;
  596.  
  597.     property LangId: Integer read GetLangId write SetLangId;
  598.     property Locale: Integer read GetLocale write SetLocale;
  599.     property CharsetType: TIvCharacterSetType read GetCharsetType;
  600.     property EMU: TIvEMU read GetEMU;
  601.     property EMUCurrencyString: String read GetEMUCurrencyString;
  602.   end;
  603.  
  604.   { TIvContext }
  605.  
  606.   TIvContextTypeItem = (ivctForm, ivctComponent);
  607.   TIvContextType = set of TIvContextTypeItem;
  608.  
  609.   TIvContextCode = (ivccFlat, ivccFull, ivccComponent, ivccForm);
  610.  
  611.   TIvContext = class(TObject)
  612.   private
  613.     FForm: String;
  614.     FComponent: String;
  615.  
  616.   public
  617.     constructor CreateValue(const form, component: String);
  618.  
  619.     procedure Clear;
  620.     procedure Assign(context: TIvContext);
  621.     function Equals(context: TIvContext): Boolean;
  622.  
  623.     class function ContextCodeToType(value: TIvContextCode): TIvContextType;
  624.     class function ContextTypeToCode(value: TIvContextType): TIvContextCode;
  625.  
  626.     property Form: String read FForm write FForm;
  627.     property Component: String read FComponent write FComponent;
  628.   end;
  629.  
  630.   { TIvTranslation }
  631.  
  632.   TIvTranslation = class(TObject)
  633.   protected
  634.     function GetKey: String;
  635.  
  636.   public
  637.     Str: String;
  638.     Form: String;
  639.     Component: String;
  640.     Current: String;
  641.     Exists: Boolean;
  642.  
  643.     constructor CreateValue(const str, form, component: String);
  644.  
  645.     class function ComposeKey(const str, form, component: String): String;
  646.  
  647.     property Key: String read GetKey;
  648.   end;
  649.  
  650.   { TIvDictionary }
  651.  
  652.   TIvCustomTranslator = class;
  653.  
  654.   EIvMulti = class(Exception);
  655.  
  656.   TIvLanguageDialogOption = (ivloShowAllLanguages, ivloUseNativeLanguage, ivloNoCenter);
  657.   TIvLanguageDialogOptions = set of TIvLanguageDialogOption;
  658.  
  659.   TIvDictionaryOption = (ivdoUpdateLocaleVariables, ivdoAutoTranslate, ivdoYear2000, ivdoTranslateResourceStrings);
  660.   TIvDictionaryOptions = set of TIvDictionaryOption;
  661.  
  662.   TIvMissingTranslation = (ivmtUseNative, ivmtUseNull, ivmtTagNative, ivmtRaiseException);
  663.  
  664.   TIvBinding = (ivbiNone, ivbiLocaleToLanguage, ivbiLanguageToLocale);
  665.  
  666. {$IFDEF WIN32}
  667.   TIvCheckLevel = (ivclNone, ivclSystem, ivclCodePage);
  668. {$ENDIF}
  669.  
  670.   TIvDictionaryFormat = (ivdfFlat, ivdfContext);
  671.   TIvTranslationMode = (ivtmSingle, ivtmMultiple);
  672.  
  673.   TIvDictionary = class(TComponent)
  674.   private
  675.     FDictionaryCode: Integer;
  676.     FOnLocaleChange: TNotifyEvent;
  677.     FOnLanguageChange: TNotifyEvent;
  678.  
  679.   protected
  680.     FEuro: TIvEuro;
  681.     FContextType: TIvContextType;
  682.     FDictionaryName: String;
  683.     FOpen: Boolean;
  684.     FLanguage: Integer;
  685.     FActiveLanguage: Integer;
  686.     FOriginalLanguage: Integer;
  687.     FLocale: Integer;
  688.     FActiveLocale: Integer;
  689.     FLanguageLocale: Integer;
  690.     FNativeLocale: Integer;
  691.     FOptions: TIvDictionaryOptions;
  692.     FMissingTranslation: TIvMissingTranslation;
  693.     FBinding: TIvBinding;
  694.     FTempLanguageData: TIvLanguage;
  695.     FLanguageData: TIvLanguage;
  696.     FTempLocaleData: TIvLocale;
  697.     FLocaleData: TIvLocale;
  698.     FTranslators: TList;
  699. {$IFDEF WIN32}
  700.     FCheckLevel: TIvCheckLevel;
  701. {$ENDIF}
  702.  
  703.     function GetContextCode: TIvContextCode;
  704.  
  705.     procedure SetDictionaryName(const value: String);
  706.  
  707.     function GetPrimaryLanguage: Integer;
  708.     procedure SetPrimaryLanguage(value: Integer);
  709.  
  710.     function GetSubLanguage: Integer;
  711.     procedure SetSubLanguage(value: Integer);
  712.  
  713.     procedure SetLocale(value: Integer);
  714.     procedure SetLanguage(value: Integer);
  715.  
  716.     function GetTranslatorCount: Integer;
  717.     function GetTranslator(i: Integer): TIvCustomTranslator;
  718.  
  719.     function GetLanguage(i: Integer): TIvLanguage;
  720.     function GetLocale(i: Integer): TIvLocale;
  721.  
  722.     procedure SetEuro(value: TIvEuro);
  723.  
  724.     procedure InitLanguage(language: Integer);
  725.     procedure InitLocale(locale: Integer);
  726.     function DecodeLocale(value: Integer): Integer;
  727.  
  728.     function GetDefaultLanguage: Integer;
  729.  
  730.     procedure UnbindTranslators;
  731.  
  732.     procedure ReadDictionaryCode(reader: TReader);
  733.     procedure WriteDictionaryCode(writer: TWriter);
  734.     procedure DefineProperties(filer: TFiler); override;
  735.  
  736.     { Implement these in your derived dictionaries }
  737.  
  738.     function GetLanguageCount: Integer; virtual; abstract;
  739.     procedure GetLanguageData(index: Integer; language: TIvLanguage); virtual; abstract;
  740.     function GetLocaleCount: Integer; virtual; abstract;
  741.     procedure GetLocaleData(index: Integer; locale: TIvLocale); virtual; abstract;
  742.  
  743.     { You might need to override this in your derived dictionaries }
  744.  
  745.     function GetTranslationCount: Integer; virtual;
  746.     procedure LanguageChanged(languageChanged, localeChanged: Boolean); virtual;
  747.  
  748.   public
  749.     constructor Create(owner: TComponent); override;
  750.     destructor Destroy; override;
  751.  
  752.     { Implement these in your derived dictionaries }
  753.  
  754.     function TranslateContextString(
  755.       const str, form, component: String;
  756.       var translation: String): Boolean; virtual; abstract;
  757.  
  758.     { You might need to override these in your derived dictionaries }
  759.  
  760.     procedure Open; virtual;
  761.     procedure Close; virtual;
  762.     function CanBeOpened: Boolean; virtual;
  763.     procedure GetLanguageDatas(list: TList); virtual;
  764.     procedure GetLocaleDatas(list: TList); virtual;
  765.     function TranslateString(
  766.       const str: String;
  767.       var translation: String): Boolean; virtual;
  768.  
  769.     { If your dictionary support multiple translation, override these in your
  770.       derived dictionaries }
  771.  
  772.     procedure TranslateStrings(translations: TList); virtual;
  773.     function GetTranslationMode: TIvTranslationMode; virtual;
  774.  
  775.     function CheckTranslation(
  776.       const native, translation: String;
  777.       ok: Boolean): String;
  778.  
  779.     procedure AddTranslator(translator: TIvCustomTranslator);
  780.     procedure RemoveTranslator(translator: TIvCustomTranslator);
  781.  
  782.     procedure GetLocales(locales: TList);
  783.     procedure GetLocaleIds(locales: TList);
  784. {$IFDEF WIN32}
  785.     class procedure GetSystemLocales(locales: TList);
  786.     class procedure GetSystemLocaleIds(locales: TList);
  787.     class function GetSystemLocaleData(id: Integer; locale: TIvLocale): Boolean;
  788. {$ENDIF}
  789.     class procedure FreeList(list: TList);
  790.  
  791.     function GetLocaleDataById(id: Integer; locale: TIvLocale): Boolean;
  792.     function LocaleToLanguage(locale: Integer): Integer;
  793.  
  794.     function DoesTranslationExist(const str: String): Boolean;
  795.     function DoesContextTranslationExist(const str, form, component: String): Boolean;
  796.  
  797.     function Translate(const str: String): String;
  798.     function TranslateContext(const str, form, component: String): String;
  799.  
  800.     procedure TranslateWindow(wnd: THandle; str: String; resize: Boolean);
  801.  
  802.     function IsOpen: Boolean;
  803.  
  804.     procedure SynchronizeLocale; virtual;
  805.     procedure SynchronizeLanguage; virtual;
  806.  
  807.     procedure GetPrimaryLanguages(primaries: TStrings; native: Boolean); virtual;
  808.     procedure GetSubLanguages(language: TIvLanguage; subs: TStrings; native: Boolean);
  809.  
  810.     function IsLocaleSupported(locale: Integer): Boolean; virtual;
  811.  
  812. {$IFDEF IVWIDE}
  813.     class procedure HandleException(sender: TObject; e: Exception);
  814. {$ENDIF}
  815.  
  816.     class function IvCompareText(
  817.       const s1, s2: String;
  818.       locale: Integer;
  819.       ignoreSymbols: Boolean): Integer;
  820.     class function IvCompareStr(
  821.       const s1, s2: String;
  822.       locale: Integer;
  823.       ignoreSymbols: Boolean): Integer;
  824.     class function IvCompareBinary(const s1, s2: String): Integer;
  825.  
  826. {$IFDEF WIN32}
  827.     class function GetCompareOptions(ignoreCase, ignoreSymbols: Boolean): Integer;
  828. {$ENDIF}
  829.  
  830. {$IFDEF IVWIDE}
  831.     class function IvWideCompareText(
  832.       const s1, s2: WideString;
  833.       locale: Integer;
  834.       ignoreSymbols: Boolean): Integer;
  835.     class function IvWideCompareStr(
  836.       const s1, s2: WideString;
  837.       locale: Integer;
  838.       ignoreSymbols: Boolean): Integer;
  839.     class function IvWideCompareBinary(const s1, s2: WideString): Integer;
  840. {$ENDIF}
  841.  
  842. {$IFDEF WIN32}
  843.     class function IsLanguageSupportedBySystem(language: TIvLanguage): Boolean;
  844.     class function IsLanguageSupportedByCodePage(language: TIvLanguage): Boolean;
  845.  
  846.     class function IsLocaleSupportedBySystem(locale: TIvLocale): Boolean;
  847.     class function IsLocaleSupportedByCodePage(locale: TIvLocale): Boolean;
  848.  
  849.     function CompareText(const s1, s2: String): Integer;
  850.     function CompareStr(const s1, s2: String): Integer;
  851. {$ELSE}
  852.     function GetSystemDefaultLCID: Integer;
  853.     function GetUserDefaultLCID: Integer;
  854. {$ENDIF}
  855.  
  856.     class function ComposeLanguageName(
  857.       language: String;
  858.       primary, codePage: Integer;
  859.       translate: Boolean;
  860.       dictionary: TIvDictionary): String;
  861.  
  862.     class function ComposeCountryName(
  863.       country: String;
  864.       primary, sub: Integer;
  865.       translate: Boolean;
  866.       dictionary: TIvDictionary): String;
  867.  
  868.     class function ComposeLocaleName(
  869.       language, country: String;
  870.       primary, sub, codePage: Integer;
  871.       translate: Boolean;
  872.       dictionary: TIvDictionary): String;
  873.  
  874.     class procedure SetTimeFormats(
  875.       format: TIvTimeFormat;
  876.       markPosition: TIvTimeMarkPosition;
  877.       leadingZeros: Boolean;
  878.       var shortTimeFormat, longTimeFormat: String);
  879.  
  880.     class function TranslateDateFormat(const formatStr: String): String;
  881.  
  882.     function IsDesignTime: Boolean;
  883.  
  884.     property NativeLocale: Integer read FNativeLocale;
  885.     property ContextType: TIvContextType read FContextType;
  886.     property ContextCode: TIvContextCode read GetContextCode;
  887.     property ActiveLanguage: Integer read FActiveLanguage;
  888.     property LanguageLocale: Integer read FLanguageLocale;
  889.     property DefaultLanguage: Integer read GetDefaultLanguage;
  890.     property TranslationCount: Integer read GetTranslationCount;
  891.     property LanguageCount: Integer read GetLanguageCount;
  892.     property Languages[i: Integer]: TIvLanguage read GetLanguage;
  893.     property LanguageData: TIvLanguage read FLanguageData;
  894.     property LocaleCount: Integer read GetLocaleCount;
  895.     property Locales[i: Integer]: TIvLocale read GetLocale;
  896.     property LocaleData: TIvLocale read FLocaleData;
  897.     property TranslatorCount: Integer read GetTranslatorCount;
  898.     property Translators[i: Integer]: TIvCustomTranslator read GetTranslator;
  899.     property Locale: Integer read FActiveLocale write SetLocale;
  900.  
  901.   published
  902.     property DictionaryName: String read FDictionaryName write SetDictionaryName;
  903.     property PrimaryLanguage: Integer read GetPrimaryLanguage write SetPrimaryLanguage default LANG_NEUTRAL;
  904.     property SubLanguage: Integer read GetSubLanguage write SetSubLanguage default SUBLANG_DEFAULT;
  905.     property Language: Integer read FLanguage write SetLanguage default LANG_USER;
  906.     property Binding: TIvBinding read FBinding write FBinding default ivbiLocaleToLanguage;
  907.     property Options: TIvDictionaryOptions read FOptions write FOptions
  908.       default [ivdoUpdateLocaleVariables, ivdoAutoTranslate, ivdoYear2000, ivdoTranslateResourceStrings];
  909.     property MissingTranslation: TIvMissingTranslation read FMissingTranslation write FMissingTranslation
  910.       default ivmtUseNative;
  911.     property Euro: TIvEuro read FEuro write SetEuro default iveNormal;
  912. {$IFDEF WIN32}
  913.     property CheckLevel: TIvCheckLevel read FCheckLevel write FCheckLevel default ivclCodePage;
  914. {$ENDIF}
  915.     property OnLanguageChange: TNotifyEvent read FOnLanguageChange write FOnLanguageChange;
  916.     property OnLocaleChange: TNotifyEvent read FOnLocaleChange write FOnLocaleChange;
  917.   end;
  918.  
  919.   TIvDictionaries = class(TObject)
  920.   private
  921.     FItems: TList;
  922.  
  923.     function GetCount: Integer;
  924.     function GetItems(index: Integer): TIvDictionary;
  925.  
  926.     procedure Add(item: TIvDictionary);
  927.     procedure Remove(item: TIvDictionary);
  928.  
  929.   public
  930.     constructor Create;
  931.     destructor Destroy; override;
  932.  
  933.     function FindDictionary(const name: String): TIvDictionary;
  934.  
  935.     property Count: Integer read GetCount;
  936.     property Items[index: Integer]: TIvDictionary read GetItems; default;
  937.   end;
  938.  
  939.   { TIvTranslator }
  940.  
  941.   TIvTranslateEvent = procedure(translator: TIvCustomTranslator) of object;
  942.  
  943.   TIvTranslatorStateValue = (ivtsBound, ivtsScaled, ivtsMirrored, ivtsPreScanning);
  944.   TIvTranslatorState = set of TIvTranslatorStateValue;
  945.  
  946.   TIvCustomTranslator = class(TComponent)
  947.   protected
  948.     FTranslations: TList;
  949.     FState: TIvTranslatorState;
  950.     FDictionary: TIvDictionary;
  951.     FDictionaryName: String;
  952.     FOnBeforeTranslate: TIvTranslateEvent;
  953.     FOnAfterTranslate: TIvTranslateEvent;
  954.     FOnLocaleChange: TNotifyEvent;
  955.     FOnLanguageChange: TNotifyEvent;
  956.  
  957.     procedure ClearTranslations;
  958.  
  959.     procedure SetDictionary(value: TIvDictionary);
  960.     procedure SetDictionaryName(const value: String);
  961.  
  962. {$IFDEF WIN32}
  963.     procedure TranslateSystemMenu(handle: THandle; mdi: Boolean);
  964.     function GetSystemMenuWinHandle: THandle; virtual;
  965. {$ENDIF}
  966.  
  967.     procedure TranslateHost; virtual;
  968.  
  969.     function IsDesignTime: Boolean;
  970.  
  971.     procedure LanguageChanged(languageChanged, localeChanged: Boolean); virtual;
  972.  
  973.   public
  974.     constructor Create(owner: TComponent); override;
  975.     destructor Destroy; override;
  976.  
  977.     procedure Translate; virtual;
  978.     procedure Unbind; virtual;
  979.     procedure UnbindAndSetNative; virtual;
  980.  
  981.     property State: TIvTranslatorState read FState;
  982.     property Dictionary: TIvDictionary read FDictionary write SetDictionary;
  983.  
  984.   published
  985.     property DictionaryName: String read FDictionaryName write SetDictionaryName;
  986.     property OnBeforeTranslate: TIvTranslateEvent read FOnBeforeTranslate write FOnBeforeTranslate;
  987.     property OnAfterTranslate: TIvTranslateEvent read FOnAfterTranslate write FOnAfterTranslate;
  988.     property OnLocaleChange: TNotifyEvent read FOnLocaleChange write FOnLocaleChange;
  989.     property OnLanguageChange: TNotifyEvent read FOnLanguageChange write FOnLanguageChange;
  990.   end;
  991.  
  992. function GetMLRegistryValue(const valueName, defaultValue: String): String;
  993.  
  994. { Translation functions}
  995.  
  996. function Translate(const str: String): String;
  997. function TranslateContext(const str, form, component: String): String;
  998. function GetDefaultDictionary: TIvDictionary;
  999.  
  1000. { Multilingual functions }
  1001.  
  1002. {$IFDEF IVWIDE}
  1003. function MlFormat(const format: String; const args: array of const): String;
  1004. procedure MlShowMessage(const msg: string);
  1005. function MlMessageDlg(const msg: string; aType: TMsgDlgType; aButtons: TMsgDlgButtons; helpCtx: Longint): Word;
  1006. {$ENDIF}
  1007.  
  1008. { Locale functions }
  1009.  
  1010. function IvDoesLanguageRequirePro(primary: Integer): Boolean;
  1011. function IvDoesLanguageRequirePro32(primary: Integer): Boolean;
  1012. function IvMakeLangId(primaryLanguage, subLanguage: Integer): Integer;
  1013. function IvMakeLcId(langId, sortId: Integer): Integer;
  1014. function IvGetPrimaryFromLocale(locale: Integer): Integer;
  1015. function IvGetSubFromLocale(locale: Integer): Integer;
  1016.  
  1017. function IvLangIdToCodePage(langId: Integer): Integer;
  1018.  
  1019. { EMU functions }
  1020.  
  1021. function IsEMUMember(locale: Integer): Boolean;
  1022. function GetEMUPhase: TIvEMU;
  1023.  
  1024. {$IFDEF WIN32}
  1025. function IvWStrPCopy(dest: PWideChar; const source: TIvWideString): PWideChar;
  1026.  
  1027. function IvWStrToStr(const source: TIvWideString; codePage: Integer): String;
  1028. function IvStrToWStr(const source: String; codePage: Integer): TIvWideString;
  1029. function IvStrLen(const str: String; codePage: Integer): Integer;
  1030.  
  1031. function IvIsCodePageSupportedBySystem(codePage: Integer): Boolean;
  1032. function IvIsLocaleSupportedByCodePage(locale: Integer): Boolean;
  1033. function IvSetKeyboardLayout(langId: Integer): HKL;
  1034. function IvResetKeyboardLayout: HKL;
  1035. function IvGetCharsetInfo(langId: Integer): TIvCharsetInfo;
  1036. function IvCodePageToCharset(codePage: Integer): TFontCharset;
  1037. function IvLangIdToCharset(langId: Integer): TFontCharset;
  1038. function IvCharsetToCode(value: TIvFontCharset): Byte;
  1039. function IvCodeToCharset(value: Byte): TIvFontCharset;
  1040. function IvGetSupportedCharsets: TIvFontCharsets;
  1041. procedure IvGetFontNames(charsets: TIvFontCharsets; names: TStrings);
  1042. procedure IvGetFontNamesOfCharset(charset: Integer; names: TStrings);
  1043.  
  1044. function SysAllocString(P: PWideChar): PWideChar; stdcall;
  1045. function SysAllocStringLen(P: PWideChar; Len: Integer): PWideChar; stdcall;
  1046. function SysReAllocStringLen(var str: PWideChar; const P: PWideChar; Len: Integer): Integer; stdcall;
  1047. procedure SysFreeString(str: PWideChar); stdcall;
  1048. function SysStringLen(str: PWideChar): Integer; stdcall;
  1049. {$ENDIF}
  1050.  
  1051. function IvGetCharacterSetType(locale: Integer): TIvCharacterSetType;
  1052. function IvIsLocaleSingleByte(locale: Integer): Boolean;
  1053. function IvIsLocaleMultiByte(locale: Integer): Boolean;
  1054. function IvIsLocaleBidirectional(locale: Integer): Boolean;
  1055.  
  1056. {$IFDEF IVWIDE}
  1057. function TranslateLoadResString(resStringRec: PResStringRec): String;
  1058. function IvLoadResString(resStringRec: PResStringRec): String;
  1059.  
  1060. function TranslateShortCutToText(shortCut: TShortCut): String;
  1061. function IvShortCutToText(shortCut: TShortCut): String;
  1062. {$ENDIF}
  1063.  
  1064. var
  1065.   Dictionaries: TIvDictionaries;
  1066.  
  1067. {$IFDEF WIN32}
  1068.   KeyboardLayout: HKL;
  1069.   {$IFDEF IVANSI}
  1070.   commonWideString: PWideChar;
  1071.   {$ENDIF}
  1072.   {$IFDEF IVWIDE}
  1073.   resStrTranslationEnabled: Boolean;
  1074.   loadResStringChanged: Boolean;
  1075.   resStringBuffer: array[0..34] of Byte;
  1076.   shortCutBuffer: array[0..34] of Byte;
  1077.   {$ENDIF}
  1078. {$ENDIF}
  1079.  
  1080. implementation
  1081.  
  1082. uses
  1083. {$IFDEF WIN32}
  1084.   Registry,
  1085. {$ELSE}
  1086.   IniFiles,
  1087. {$ENDIF}
  1088. {$IFDEF IVVB}
  1089.   InnoOCX,
  1090. {$ENDIF}
  1091. {$IFDEF IVBINARY}
  1092.   IvStamp, IvDemoD,
  1093. {$ENDIF}
  1094.   Consts, Messages, IvParser;
  1095.  
  1096. {$IFDEF WIN32}
  1097. const
  1098.   CHARSET_COUNT_C = 32;
  1099.   CHARSETSET_TO_ID_C: array[0..CHARSET_COUNT_C - 1] of TIvCharsetInfo =
  1100.   (
  1101.     (charSet: ANSI_CHARSET; codePage: 1252),        { 0, Western Europe }
  1102.     (charSet: EASTEUROPE_CHARSET; codePage: 1250),  { 1, Eastern Europe }
  1103.     (charSet: RUSSIAN_CHARSET; codePage: 1251),     { 2, Cyrillic }
  1104.     (charSet: GREEK_CHARSET; codePage: 1253),       { 3, Greek }
  1105.     (charSet: TURKISH_CHARSET; codePage: 1254),     { 4, Turkish }
  1106.     (charSet: 0; codePage: 0),
  1107.     (charSet: 0; codePage: 0),
  1108.     (charSet: BALTIC_CHARSET; codePage: 1257),      { 7, Baltic }
  1109.     (charSet: 0; codePage: 0),
  1110.     (charSet: 0; codePage: 0),
  1111.     (charSet: 0; codePage: 0),
  1112.     (charSet: 0; codePage: 0),
  1113.     (charSet: 0; codePage: 0),
  1114.     (charSet: 0; codePage: 0),
  1115.     (charSet: 0; codePage: 0),
  1116.     (charSet: 0; codePage: 0),
  1117.     (charSet: 0; codePage: 0),
  1118.     (charSet: 0; codePage: 0),
  1119.     (charSet: 0; codePage: 0),
  1120.     (charSet: 0; codePage: 0),
  1121.     (charSet: 0; codePage: 0),
  1122.     (charSet: 0; codePage: 0),
  1123.     (charSet: 0; codePage: 0),
  1124.     (charSet: 0; codePage: 0),
  1125.     (charSet: 0; codePage: 0),
  1126.     (charSet: 0; codePage: 0),
  1127.     (charSet: 0; codePage: 0),
  1128.     (charSet: 0; codePage: 0),
  1129.     (charSet: 0; codePage: 0),
  1130.     (charSet: 0; codePage: 0),
  1131.     (charSet: 0; codePage: 0),
  1132.     (charSet: 0; codePage: 0)
  1133.   );
  1134. {$ENDIF}
  1135.  
  1136. var
  1137.   euroUsage: TIvEuro;
  1138. {$IFDEF WIN32}
  1139.   enumInteger: Integer;
  1140.   enumList: TList;
  1141.   supported: Boolean;
  1142. {$ELSE}
  1143.   userDefaultLCID: Integer;
  1144. {$ENDIF}
  1145.  
  1146. function GetMLRegistryValue(const valueName, defaultValue: String): String;
  1147. var
  1148. {$IFDEF WIN32}
  1149.   registry: TRegistry;
  1150. {$ELSE}
  1151.   iniFile: TIniFile;
  1152. {$ENDIF}
  1153. begin
  1154. {$IFDEF WIN32}
  1155.   registry := TRegistry.Create;
  1156.   try
  1157.     registry.RootKey := HKEY_LOCAL_MACHINE;
  1158.     if registry.OpenKey(KEY_C, False) and registry.ValueExists(valueName) then
  1159.       Result := registry.ReadString(valueName)
  1160.     else
  1161.       Result := defaultValue;
  1162.   finally
  1163.     registry.Free;
  1164.   end;
  1165. {$ELSE}
  1166.   iniFile := TIniFile.Create(INI_FILE_C);
  1167.   try
  1168.     Result := iniFile.ReadString(SECTION_C, valueName, defaultValue);
  1169.   finally
  1170.     iniFile.Free;
  1171.   end;
  1172. {$ENDIF}
  1173. end;
  1174.  
  1175.  
  1176. { TIvPropInfoList }
  1177.  
  1178. function GetPropList(typeInfo: PTypeInfo; typeKinds: TTypeKinds; propList: PPropList): Integer;
  1179. var
  1180.   i, count: Integer;
  1181.   propInfo: PPropInfo;
  1182.   tempList: PPropList;
  1183. begin
  1184.   Result := 0;
  1185.   count := GetTypeData(TypeInfo)^.PropCount;
  1186.   if count > 0 then
  1187.   begin
  1188.     GetMem(tempList, count * SizeOf(Pointer));
  1189.     try
  1190.       GetPropInfos(typeInfo, tempList);
  1191.       for i := 0 to Count - 1 do
  1192.       begin
  1193.         propInfo := tempList^[i];
  1194.         if (propInfo <> nil) and (propInfo^.PropType^.Kind in typeKinds) then
  1195.         begin
  1196.           if propList <> nil then
  1197.             propList^[Result] := propInfo;
  1198.           Inc(Result);
  1199.         end;
  1200.       end;
  1201.     finally
  1202.       FreeMem(TempList, count*SizeOf(Pointer));
  1203.     end;
  1204.   end;
  1205. end;
  1206.  
  1207. constructor TIvPropInfoList.Create(obj: TObject; Filter: TTypeKinds);
  1208. begin
  1209.   if obj.ClassInfo = nil then
  1210.   begin
  1211.     FCount:=0;
  1212.     FSize:=0;
  1213.   end
  1214.   else
  1215.   begin
  1216.     FCount := GetPropList(obj.ClassInfo, Filter, nil);
  1217.     FSize := FCount*SizeOf(Pointer);
  1218.     GetMem(FList, FSize);
  1219.     GetPropList(obj.ClassInfo, Filter, FList);
  1220.   end;
  1221. end;
  1222.  
  1223. destructor TIvPropInfoList.Destroy;
  1224. begin
  1225.   if FList <> nil then
  1226.     FreeMem(FList, FSize);
  1227. end;
  1228.  
  1229. function TIvPropInfoList.Get(Index: Integer): PPropInfo;
  1230. begin
  1231. {$IFDEF VER125}
  1232.   Result := PPropList(FList)^[Index];
  1233. {$ELSE}
  1234.   Result := FList^[Index];
  1235. {$ENDIF}
  1236. end;
  1237.  
  1238. {$IFDEF IVWIDE}
  1239. function MlFormat(const format: String; const args: array of const): String;
  1240. begin
  1241.   Result := SysUtils.Format(Translate(format), args);
  1242. end;
  1243.  
  1244. procedure MlShowMessage(const msg: string);
  1245. begin
  1246.   Dialogs.ShowMessage(Translate(msg));
  1247. end;
  1248.  
  1249. function MlMessageDlg(const msg: string; aType: TMsgDlgType; aButtons: TMsgDlgButtons; helpCtx: Longint): Word;
  1250. begin
  1251.   Result := Dialogs.MessageDlg(Translate(msg), aType, aButtons, helpCtx);
  1252. end;
  1253. {$ENDIF}
  1254.  
  1255. { TIvLanguage }
  1256.  
  1257. constructor TIvLanguage.Create;
  1258. begin
  1259.   CreateValue(0, 0, 0, '', '', '', '', 0, []);
  1260. end;
  1261.  
  1262. constructor TIvLanguage.CreateValue(
  1263.   primary, defaultSub, codePage: Integer;
  1264.   const subs, englishName, nativeName: String;
  1265.   const fontName: String;
  1266.   fontSize: Integer;
  1267.   options: TIvLanguageOptions);
  1268. begin
  1269.   inherited Create;
  1270.  
  1271.   FSubs := TStringList.Create;
  1272.   FISOCountries := TStringList.Create;
  1273.  
  1274.   FPrimary := primary;
  1275.   FDefaultSub := defaultSub;
  1276.   Self.CodePage := codePage;
  1277.   AllSubs := subs;
  1278.   FEnglishName := englishName;
  1279.   FNativeName := nativeName;
  1280.   FFontName := fontName;
  1281.   FFontSize := fontSize;
  1282.   FOptions := options;
  1283. end;
  1284.  
  1285. destructor TIvLanguage.Destroy;
  1286. begin
  1287.   FSubs.Free;
  1288.   FISOCountries.Free;
  1289.   inherited Destroy;
  1290. end;
  1291.  
  1292. procedure TIvLanguage.SetCodePage(value: Integer);
  1293. begin
  1294.   FCodePage := value;
  1295. {$IFDEF WIN32}
  1296.   if FCharset = 0 then
  1297.     FCharset := IvCodePageToCharset(FCodePage);
  1298. {$ENDIF}
  1299. end;
  1300.  
  1301. function TIvLanguage.PrimaryEquals(language: TIvLanguage): Boolean;
  1302. begin
  1303.   Result := (Primary = language.Primary) and (CodePage = language.CodePage);
  1304. end;
  1305.  
  1306. procedure TIvLanguage.Init;
  1307. begin
  1308.   { Old format used -1 as the fake. Now it is 0 }
  1309.  
  1310.   if FPrimary < 0 then
  1311.     FPrimary := LANG_NEUTRAL;
  1312.  
  1313.   if FPrimary = LANG_NEUTRAL then
  1314.   begin
  1315.     FDefaultSub := 0;
  1316.     FSubs.Clear;
  1317.     FOptions := [ivloPureASCII];
  1318.   end
  1319.   else
  1320.   begin
  1321.     { If the default sub of the language is negative or SUBLANG_NEUTRAL,
  1322.       SUBLANG_DEFAULT is used. If the language contains subs the first sub
  1323.       is used. }
  1324.  
  1325.     if FDefaultSub < SUBLANG_DEFAULT then
  1326.     begin
  1327.       FDefaultSub := SUBLANG_DEFAULT;
  1328.       if FSubs.Count > 0 then
  1329.         FDefaultSub := StrToInt(FSubs[0]);
  1330.     end;
  1331.   end;
  1332.  
  1333.   if FPrimary = LANG_NEUTRAL then
  1334.   begin
  1335.     EnglishName := 'Native';
  1336.     NativeName := 'Native';
  1337.   end
  1338.   else
  1339.   begin
  1340. {$IFDEF WIN32}
  1341.     if ISOLanguage = '' then
  1342.       ISOLanguage := GetLocaleStr(Locale, LOCALE_SISO639LANGNAME, '');
  1343.  
  1344.     if ISODefaultCountry = '' then
  1345.       ISODefaultCountry := GetLocaleStr(Locale, LOCALE_SISO3166CTRYNAME, '');
  1346.  
  1347.     if EnglishName = '' then
  1348.       EnglishName := TIvDictionary.ComposeLanguageName(
  1349.         GetLocaleStr(Locale, LOCALE_SENGLANGUAGE, ''),
  1350.         primary,
  1351.         codePage,
  1352.         False,
  1353.         nil);
  1354.  
  1355.     if NativeName = '' then
  1356.       NativeName := GetLocaleStr(Locale, LOCALE_SNATIVELANGNAME, '');
  1357.  
  1358.     if FCodePage = 0 then
  1359.       FCodePage := IvLangIdToCodePage(Locale);
  1360. {$ENDIF}
  1361.     if FCodePage = 0 then
  1362.       FCodePage := WESTERN_CP_C;
  1363.   end;
  1364.  
  1365.   if FActiveSub = 0 then
  1366.     FActiveSub := FDefaultSub;
  1367.     
  1368. {$IFDEF WIN32}
  1369.   if FCharset = 0 then
  1370.     FCharset := IvCodePageToCharset(FCodePage);
  1371. {$ENDIF}
  1372. end;
  1373.  
  1374. procedure TIvLanguage.Assign(source: TIvLanguage);
  1375. begin
  1376.   FCodePage := source.FCodePage;
  1377. {$IFDEF WIN32}
  1378.   FCharset := source.FCharset;
  1379. {$ENDIF}
  1380.   FPrimary := source.FPrimary;
  1381.   FVariant := source.FVariant;
  1382.   FDefaultSub := source.FDefaultSub;
  1383.   FActiveSub := source.FActiveSub;
  1384.   FSubs.Assign(source.FSubs);
  1385.   FISOLanguage := source.FISOLanguage;
  1386.   FISODefaultCountry := source.FISODefaultCountry;
  1387.   FISOCountries.Assign(source.FISOCountries);
  1388.   FEnglishName := source.FEnglishName;
  1389.   FNativeName := source.FNativeName;
  1390.   FFontName := source.FFontName;
  1391.   FFontSize := source.FFontSize;
  1392.   FOptions := source.FOptions;
  1393. end;
  1394.  
  1395. function TIvLanguage.Copy: TIvLanguage;
  1396. begin
  1397.   Result := TIvLanguage.Create;
  1398.   Result.Assign(Self);
  1399. end;
  1400.  
  1401. function TIvLanguage.GetOptionsAsInt: Integer;
  1402. begin
  1403.   Result := 0;
  1404.  
  1405.   if ivloTest in FOptions then
  1406.     Result := Result or TEST_MASK_C;
  1407.  
  1408.   if ivloPureASCII in FOptions then
  1409.     Result := Result or PURE_ASCII_MASK_C;
  1410. end;
  1411.  
  1412. procedure TIvLanguage.SetOptionsAsInt(value: Integer);
  1413. begin
  1414.   FOptions := [];
  1415.  
  1416.   if (TEST_MASK_C and value) <> 0 then
  1417.     FOptions := FOptions + [ivloTest];
  1418.  
  1419.   if (PURE_ASCII_MASK_C and value) <> 0 then
  1420.     FOptions := FOptions + [ivloPureASCII];
  1421. end;
  1422.  
  1423. function TIvLanguage.GetCharsetType: TIvCharacterSetType;
  1424. begin
  1425.   Result := IvGetCharacterSetType(Locale);
  1426. end;
  1427.  
  1428. function TIvLanguage.GetAllSubs: String;
  1429. var
  1430.   i: Integer;
  1431. begin
  1432.   Result := '';
  1433.   for i := 0 to FSubs.Count - 1 do
  1434.   begin
  1435.     if i = 0 then
  1436.       Result := FSubs[i]
  1437.     else
  1438.       Result := Result + IV_SUB_SEPARATOR_C + FSubs[i];
  1439.   end;
  1440. end;
  1441.  
  1442. procedure TIvLanguage.SetAllSubs(const value: String);
  1443. var
  1444.   sub: Integer;
  1445.   parser: TIvStringParser;
  1446. begin
  1447.   FSubs.Clear;
  1448.   parser := TIvStringParser.CreateValue(value, IV_SUB_SEPARATOR_C);
  1449.   while not parser.Eol do
  1450.   begin
  1451.     sub := parser.GetInteger;
  1452.     if sub > 0 then
  1453.       FSubs.Add(IntToStr(sub));
  1454.   end;
  1455.   parser.Free;
  1456. end;
  1457.  
  1458. function TIvLanguage.GetBundleExtension: String;
  1459. begin
  1460.   if FISOCountries.Count > 0 then
  1461.     Result := '_' + ISOLanguage + '_' + FISOCountries[0]
  1462.   else
  1463.     Result := '_' + ISOLanguage;
  1464. end;
  1465.  
  1466. function TIvLanguage.GetISOAllCountries: String;
  1467. var
  1468.   i: Integer;
  1469. begin
  1470.   Result := '';
  1471.   for i := 0 to FISOCountries.Count - 1 do
  1472.   begin
  1473.     if i = 0 then
  1474.       Result := FISOCountries[i]
  1475.     else
  1476.       Result := Result + IV_SUB_SEPARATOR_C + FISOCountries[i];
  1477.   end;
  1478. end;
  1479.  
  1480. procedure TIvLanguage.SetISOAllCountries(const value: String);
  1481. var
  1482.   parser: TIvStringParser;
  1483. begin
  1484.   FISOCountries.Clear;
  1485.   parser := TIvStringParser.CreateValue(value, IV_SUB_SEPARATOR_C);
  1486.   while not parser.Eol do
  1487.     FISOCountries.Add(parser.GetString);
  1488.   parser.Free;
  1489. end;
  1490.  
  1491. class function TIvLanguage.SubStrToSubId(const str: String): Integer;
  1492. var
  1493.   parser: TIvAnsiParser;
  1494. {$IFNDEF WIN32}
  1495.   buffer: array[0..255] of Char;
  1496. {$ENDIF}
  1497. begin
  1498.   if str = '' then
  1499.     Result := 0
  1500.   else
  1501.   begin
  1502.     parser := TIvAnsiParser.CreateValue(
  1503. {$IFDEF WIN32}
  1504.       str,
  1505. {$ELSE}
  1506.       StrPCopy(buffer, str),
  1507. {$ENDIF}
  1508.       ',');
  1509.     try
  1510.       Result := parser.GetInteger;
  1511.     finally
  1512.       parser.Free;
  1513.     end;
  1514.   end;
  1515. end;
  1516.  
  1517. function TIvLanguage.GetSub: Integer;
  1518. begin
  1519.   if SubCount = 0 then
  1520.     Result := SUBLANG_NEUTRAL
  1521.   else
  1522.     Result := Subs[0];
  1523. end;
  1524.  
  1525. function TIvLanguage.GetSubCount: Integer;
  1526. begin
  1527.   Result := FSubs.Count;
  1528. end;
  1529.  
  1530. procedure TIvLanguage.ClearSubs;
  1531. begin
  1532.   FSubs.Clear;
  1533. end;
  1534.  
  1535. procedure TIvLanguage.AddSub(sub: Integer);
  1536. var
  1537.   i: Integer;
  1538.   found: Boolean;
  1539. begin
  1540.   found := False;
  1541.   for i := 0 to SubCount - 1 do
  1542.     if Subs[i] = sub then
  1543.     begin
  1544.       found := True;
  1545.       Break;
  1546.     end;
  1547.  
  1548.   if not found then
  1549.     FSubs.Add(IntToStr(sub));
  1550. end;
  1551.  
  1552. function TIvLanguage.GetSubs(i: Integer): Integer;
  1553. begin
  1554.   Result := StrToInt(FSubs[i]);
  1555. end;
  1556.  
  1557. procedure TIvLanguage.SetActiveSub(value: Integer);
  1558. var
  1559.   i: Integer;
  1560.   found: Boolean;
  1561. begin
  1562.   if value <> FActiveSub then
  1563.   begin
  1564.     found := False;
  1565.     for i := 0 to SubCount - 1 do
  1566.       if value = Subs[i] then
  1567.       begin
  1568.         found := True;
  1569.         Break;
  1570.       end;
  1571.       
  1572.     if (not found and (SubCount > 0)) or (value < 0) then
  1573.       FActiveSub := FDefaultSub
  1574.     else
  1575.       FActiveSub := value
  1576.   end;
  1577. end;
  1578.  
  1579. function TIvLanguage.GetISOCountry: String;
  1580. begin
  1581.   if ISOCountryCount = 0 then
  1582.     Result := ''
  1583.   else
  1584.     Result := ISOCountries[0];
  1585. end;
  1586.  
  1587. function TIvLanguage.GetISOCountryCount: Integer;
  1588. begin
  1589.   Result := FISOCOuntries.Count;
  1590. end;
  1591.  
  1592. function TIvLanguage.GetISOCountries(i: Integer): String;
  1593. begin
  1594.   Result := FISOCOuntries[i];
  1595. end;
  1596.  
  1597. procedure TIvLanguage.ClearISOCountries;
  1598. begin
  1599.   FISOCOuntries.Clear;
  1600. end;
  1601.  
  1602. procedure TIvLanguage.AddISOCountry(country: String);
  1603. var
  1604.   i: Integer;
  1605.   found: Boolean;
  1606. begin
  1607.   found := False;
  1608.   for i := 0 to ISOCountryCount - 1 do
  1609.     if ISOCountries[i] = country then
  1610.     begin
  1611.       found := True;
  1612.       Break;
  1613.     end;
  1614.  
  1615.   if not found then
  1616.     FISOCOuntries.Add(country);
  1617. end;
  1618.  
  1619. function TIvLanguage.GetDefaultLocale: Integer;
  1620. begin
  1621.   { The fake language contains the primary id in the default sub id }
  1622.  
  1623.   if FPrimary = LANG_NEUTRAL then
  1624.     Result := IvMakeLcId(IvMakeLangId(FDefaultSub, SUBLANG_NEUTRAL), SORT_DEFAULT)
  1625.   else
  1626.     Result := IvMakeLcId(IvMakeLangId(FPrimary, FDefaultSub), SORT_DEFAULT);
  1627. end;
  1628.  
  1629. function TIvLanguage.GetActiveLocale: Integer;
  1630. begin
  1631.   Result := IvMakeLcId(IvMakeLangId(FPrimary, FActiveSub), SORT_DEFAULT);
  1632. end;
  1633.  
  1634. function TIvLanguage.GetLangId: Integer;
  1635. begin
  1636.   if FPrimary = LANG_NEUTRAL then
  1637.     Result := IvMakeLangId(LANG_NEUTRAL, SUBLANG_NEUTRAL)
  1638.   else if FSubs.Count = 0 then
  1639.     Result := IvMakeLangId(FPrimary, SUBLANG_NEUTRAL)
  1640.   else
  1641.     Result := IvMakeLangId(FPrimary, Subs[0]);
  1642. end;
  1643.  
  1644. function TIvLanguage.GetLocale: Integer;
  1645. var
  1646.   sub: Integer;
  1647. begin
  1648.   if FPrimary = LANG_NEUTRAL then
  1649.     Result := IvMakeLcId(IvMakeLangId(LANG_NEUTRAL, SUBLANG_NEUTRAL), SORT_DEFAULT)
  1650.   else
  1651.   begin
  1652.     if FSubs.Count > 0 then
  1653.       sub := Subs[0]
  1654.     else
  1655.       sub := FDefaultSub;
  1656.  
  1657.     { If sub is not specified, determines the sub from the code page }
  1658.  
  1659.     if sub = 0 then
  1660.     begin
  1661.       if FPrimary = LANG_CROATIAN then
  1662.         case FCodePage of
  1663.           EAST_EUROPE_CP_C: sub := SUBLANG_DEFAULT;
  1664.           CYRILLIC_CP_C: sub := SUBLANG_SERBIAN_CYRILLIC;
  1665.         end;
  1666.     end;
  1667.  
  1668.     Result := IvMakeLcId(IvMakeLangId(FPrimary, sub), SORT_DEFAULT);
  1669.   end;
  1670. end;
  1671.  
  1672. function TIvLanguage.GetDisplayName(
  1673.   displayName: TIvDisplayName;
  1674.   dictionary: TIvDictionary): String;
  1675. begin
  1676.   case displayName of
  1677.     ivdnEnglish:
  1678.       Result := TIvDictionary.ComposeLanguageName(
  1679.         EnglishName,
  1680.         Primary,
  1681.         CodePage,
  1682.         False,
  1683.         nil);
  1684.  
  1685.     ivdnNative:
  1686.       Result := TIvDictionary.ComposeLanguageName(
  1687.         NativeName,
  1688.         Primary,
  1689.         CodePage,
  1690.         False,
  1691.         nil);
  1692.  
  1693.     ivdnTranslated:
  1694.       Result := TIvDictionary.ComposeLanguageName(
  1695.         EnglishName,
  1696.         Primary,
  1697.         CodePage,
  1698.         True,
  1699.         dictionary);
  1700.   end;
  1701. end;
  1702.  
  1703.  
  1704. { TIvLocale }
  1705.  
  1706. function TIvLocale.GetLangId: Integer;
  1707. begin
  1708.   Result := IvMakeLangId(Primary, Sub);
  1709. end;
  1710.  
  1711. procedure TIvLocale.SetLangId(value: Integer);
  1712. begin
  1713.   Primary := IvGetPrimaryFromLocale(value);
  1714.   Sub := IvGetPrimaryFromLocale(value);
  1715. end;
  1716.  
  1717. function TIvLocale.GetLocale: Integer;
  1718. begin
  1719.   Result := IvMakeLcId(IvMakeLangId(Primary, Sub), SortId);
  1720. end;
  1721.  
  1722. procedure TIvLocale.SetLocale(value: Integer);
  1723. begin
  1724.   Primary := IvGetPrimaryFromLocale(value);
  1725.   Sub := IvGetPrimaryFromLocale(value);
  1726. end;
  1727.  
  1728. function TIvLocale.GetCharsetType: TIvCharacterSetType;
  1729. begin
  1730.   Result := IvGetCharacterSetType(Locale);
  1731. end;
  1732.  
  1733. function TIvLocale.GetEMU: TIvEMU;
  1734. begin
  1735.   if IsEMUMember(Locale) then
  1736.     Result := GetEMUPhase
  1737.   else
  1738.     Result := iveNone;
  1739. end;
  1740.  
  1741. function TIvLocale.GetEMUCurrencyString: String;
  1742. begin
  1743.   if euroUsage = iveIgnore then
  1744.     Result := CurrencyString
  1745.   else
  1746.     case EMU of
  1747.       iveLocalAndEuro:
  1748.         if euroUsage = iveNormal then
  1749.           Result := CurrencyString
  1750.         else
  1751.           Result := EURO_CHAR_C;
  1752.  
  1753.       iveEuroAndLocal,
  1754.       iveEuro:
  1755.         Result := EURO_CHAR_C;
  1756.     else
  1757.       Result := CurrencyString;
  1758.     end;
  1759. end;
  1760.  
  1761. function TIvLocale.Copy: TIvLocale;
  1762. begin
  1763.   Result := TIvLocale.Create;
  1764.   Result.Assign(Self);
  1765. end;
  1766.  
  1767. procedure TIvLocale.Assign(source: TIvLocale);
  1768. var
  1769.   i: Integer;
  1770. begin
  1771.   Primary := source.Primary;
  1772.   Sub := source.Sub;
  1773.   CodePage := source.CodePage;
  1774.   ISOLanguage := source.ISOLanguage;
  1775.   ISOCountry := source.ISOCountry;
  1776.   IsCustom := source.IsCustom;
  1777.  
  1778.   EnglishLanguageName := source.EnglishLanguageName;
  1779.   EnglishCountryName := source.EnglishCountryName;
  1780.   NativeLanguageName := source.NativeLanguageName;
  1781.   NativeCountryName := source.NativeCountryName;
  1782.   Win16LanguageName := source.Win16LanguageName;
  1783.   Win16CountryName := source.Win16CountryName;
  1784.  
  1785.   CurrencyString := source.CurrencyString;
  1786.   CurrencyFormat := source.CurrencyFormat;
  1787.   NegCurrFormat := source.NegCurrFormat;
  1788.   CurrencyDecimals := source.CurrencyDecimals;
  1789.   ThousandSeparator := source.ThousandSeparator;
  1790.   DecimalSeparator := source.DecimalSeparator;
  1791.  
  1792.   DateSeparator := source.DateSeparator;
  1793.   ShortDateFormat := source.ShortDateFormat;
  1794.   LongDateFormat := source.LongDateFormat;
  1795.  
  1796.   TimeSeparator := source.TimeSeparator;
  1797.   TimeAMString := source.TimeAMString;
  1798.   TimePMString := source.TimePMString;
  1799.   TimeLeadingZeros := source.TimeLeadingZeros;
  1800.   TimeFormat := source.TimeFormat;
  1801.   TimeMarkPosition := source.TimeMarkPosition;
  1802.  
  1803.   MeasurementSystem := source.MeasurementSystem;
  1804.   CalendarType := source.CalendarType;
  1805.   OptionalCalendarType := source.OptionalCalendarType;
  1806.   FirstDayOfWeek := source.FirstDayOfWeek;
  1807.   FirstWeekOfYear := source.FirstWeekOfYear;
  1808.  
  1809.   for i := 1 to 12 do
  1810.   begin
  1811.     ShortMonthNames[i] := source.ShortMonthNames[i];
  1812.     LongMonthNames[i] := source.LongMonthNames[i];
  1813.   end;
  1814.   for i := 1 to 7 do
  1815.   begin
  1816.     ShortDayNames[i] := source.ShortDayNames[i];
  1817.     LongDayNames[i] := source.LongDayNames[i];
  1818.   end;
  1819. end;
  1820.  
  1821. function TIvLocale.GetDisplayName(
  1822.   displayName: TIvDisplayName;
  1823.   dictionary: TIvDictionary): String;
  1824. begin
  1825.   case displayName of
  1826.     ivdnEnglish:
  1827.       Result := TIvDictionary.ComposeLocaleName(
  1828.         EnglishLanguageName,
  1829.         EnglishCountryName,
  1830.         Primary,
  1831.         Sub,
  1832.         CodePage,
  1833.         False,
  1834.         nil);
  1835.  
  1836.     ivdnNative:
  1837.       Result := TIvDictionary.ComposeLocaleName(
  1838.         NativeLanguageName,
  1839.         NativeCountryName,
  1840.         Primary,
  1841.         Sub,
  1842.         CodePage,
  1843.         False,
  1844.         nil);
  1845.  
  1846.     ivdnTranslated:
  1847.       Result := TIvDictionary.ComposeLocaleName(
  1848.         EnglishLanguageName,
  1849.         EnglishCountryName,
  1850.         Primary,
  1851.         Sub,
  1852.         CodePage,
  1853.         True,
  1854.         dictionary);
  1855.   end;
  1856. end;
  1857.  
  1858. procedure TIvLocale.Init;
  1859. begin
  1860.   if Primary <> LANG_NEUTRAL then
  1861.   begin
  1862. {$IFDEF WIN32}
  1863.     if EnglishLanguageName = '' then
  1864.       EnglishLanguageName := GetLocaleStr(Locale, LOCALE_SENGLANGUAGE, '');
  1865.  
  1866.     if NativeLanguageName = '' then
  1867.       NativeLanguageName := GetLocaleStr(Locale, LOCALE_SNATIVELANGNAME, '');
  1868.  
  1869.     if EnglishCountryName = '' then
  1870.       EnglishCountryName := GetLocaleStr(Locale, LOCALE_SENGCOUNTRY, '');
  1871.  
  1872.     if NativeCountryName = '' then
  1873.       NativeCountryName := GetLocaleStr(Locale, LOCALE_SNATIVECTRYNAME, '');
  1874.  
  1875.     if CodePage = 0 then
  1876.       CodePage := IvLangIdToCodePage(Locale);
  1877. {$ENDIF}
  1878.     if CodePage = 0 then
  1879.       CodePage := 1252;
  1880.   end;
  1881.  
  1882. {$IFDEF WIN32}
  1883.   if Charset = 0 then
  1884.     Charset := IvLangIdToCharset(Locale);
  1885. {$ENDIF}
  1886. end;
  1887.  
  1888.  
  1889. { TIvContext }
  1890.  
  1891. constructor TIvContext.CreateValue(const form, component: String);
  1892. begin
  1893.   inherited Create;
  1894.   FForm := form;
  1895.   FComponent := component;
  1896. end;
  1897.  
  1898. procedure TIvContext.Clear;
  1899. begin
  1900.   FForm := '';
  1901.   FComponent := '';
  1902. end;
  1903.  
  1904. procedure TIvContext.Assign(context: TIvContext);
  1905. begin
  1906.   FForm := context.Form;
  1907.   FComponent := context.Component;
  1908. end;
  1909.  
  1910. function TIvContext.Equals(context: TIvContext): Boolean;
  1911. begin
  1912.   Result := (FForm = context.Form) and (FComponent = context.Component);
  1913. end;
  1914.  
  1915. class function TIvContext.ContextCodeToType(value: TIvContextCode): TIvContextType;
  1916. begin
  1917.   case value of
  1918.     ivccFlat: Result := [];
  1919.     ivccFull: Result := [ivctForm, ivctComponent];
  1920.     ivccComponent: Result := [ivctComponent];
  1921.     ivccForm: Result := [ivctForm];
  1922.   end;
  1923. end;
  1924.  
  1925. class function TIvContext.ContextTypeToCode(value: TIvContextType): TIvContextCode;
  1926. begin
  1927.   if value = [] then
  1928.     Result := ivccFlat
  1929.   else if value = [ivctForm, ivctComponent] then
  1930.     Result := ivccFull
  1931.   else if value = [ivctComponent] then
  1932.     Result := ivccComponent
  1933.   else
  1934.     Result := ivccForm;
  1935. end;
  1936.  
  1937.  
  1938. { TIvTranslation }
  1939.  
  1940. constructor TIvTranslation.CreateValue(const str, form, component: String);
  1941. begin
  1942.   inherited Create;
  1943.   Self.Str := str;
  1944.   Self.Form := form;
  1945.   Self.Component := component;
  1946. end;
  1947.  
  1948. function TIvTranslation.GetKey: String;
  1949. begin
  1950.   Result := ComposeKey(Str, Form, Component);
  1951. end;
  1952.  
  1953. class function TIvTranslation.ComposeKey(const str, form, component: String): String;
  1954. begin
  1955.   Result := Str + CONTEXT_SEPARATOR_C + Form + Component;
  1956. end;
  1957.  
  1958.  
  1959. { TIvDictionary }
  1960.  
  1961. constructor TIvDictionary.Create(owner: TComponent);
  1962. begin
  1963.   inherited Create(owner);
  1964.  
  1965.   Dictionaries.Add(Self);
  1966. {$IFDEF IVWIDE}
  1967.   if not Assigned(Application.OnException) then
  1968.     Application.OnException := HandleException;
  1969. {$ENDIF}
  1970.  
  1971.   FOpen := False;
  1972.   FContextType := [];
  1973.   FActiveLocale := 0;
  1974.   FNativeLocale := 0;
  1975.   FLocale := IvMakeLcId(IvMakeLangId(LANG_NEUTRAL, SUBLANG_DEFAULT), SORT_DEFAULT);
  1976.   FLanguage := LANG_USER;
  1977.   FBinding := ivbiLocaleToLanguage;
  1978.   FEuro := iveNormal;
  1979.   FDictionaryCode := Integer(liProfessional);
  1980.  
  1981.   FOptions := [ivdoUpdateLocaleVariables, ivdoAutoTranslate, ivdoYear2000, ivdoTranslateResourceStrings];
  1982.   FMissingTranslation := ivmtUseNative;
  1983. {$IFDEF WIN32}
  1984.   FCheckLevel := ivclCodePage;
  1985. {$ENDIF}
  1986.  
  1987.   FTranslators := TList.Create;
  1988.   FLanguageData := TIvLanguage.Create;
  1989.   FTempLanguageData := nil;
  1990.   FLocaleData := TIvLocale.Create;
  1991.   FTempLocaleData := nil;
  1992. end;
  1993.  
  1994. destructor TIvDictionary.Destroy;
  1995. begin
  1996.   UnbindTranslators;
  1997.   if Dictionaries <> nil then
  1998.     Dictionaries.Remove(Self);
  1999.   FLocaleData.Free;
  2000.   FTempLocaleData.Free;
  2001.   FLanguageData.Free;
  2002.   FTempLanguageData.Free;
  2003.   FTranslators.Free;
  2004.   inherited Destroy;
  2005. end;
  2006.  
  2007. function TIvDictionary.GetContextCode: TIvContextCode;
  2008. begin
  2009.   Result := TIvContext.ContextTypeToCode(FContextType);
  2010. end;
  2011.  
  2012. procedure TIvDictionary.SetDictionaryName(const value: String);
  2013. begin
  2014.   FDictionaryName := value;
  2015. end;
  2016.  
  2017. function TIvDictionary.GetPrimaryLanguage: Integer;
  2018. begin
  2019.   Result := IvGetPrimaryFromLocale(FLocale);
  2020. end;
  2021.  
  2022. procedure TIvDictionary.SetPrimaryLanguage(value: Integer);
  2023. begin
  2024.   SetLocale(IvMakeLcId(IvMakeLangId(value, SubLanguage), SORT_DEFAULT));
  2025. end;
  2026.  
  2027. function TIvDictionary.GetSubLanguage: Integer;
  2028. begin
  2029.   Result := IvGetSubFromLocale(FLocale);
  2030. end;
  2031.  
  2032. procedure TIvDictionary.SetSubLanguage(value: Integer);
  2033. begin
  2034.   SetLocale(IvMakeLcId(IvMakeLangId(PrimaryLanguage, value), SORT_DEFAULT));
  2035. end;
  2036.  
  2037. procedure TIvDictionary.ReadDictionaryCode(reader: TReader);
  2038. {$IFDEF IVBINARY}
  2039. var
  2040.   valid: Boolean;
  2041.   dialog: TIvDemoDialog;
  2042. {$ENDIF}
  2043. begin
  2044.   FDictionaryCode := reader.ReadInteger;
  2045. {$IFDEF IVBINARY}
  2046.   if ((FDictionaryCode = Integer(liNone)) or
  2047.     (FDictionaryCode = Integer(liEvaluation))) and
  2048.     not IsDesignTime then
  2049.   begin
  2050.   {$IFDEF WIN32}
  2051.     valid := GetTimeStampDaysLeft(
  2052.       KEY_C,
  2053.       STAMP_C,
  2054.     {$IFDEF IVVB}
  2055.       VB_CRYPTO_KEY_C
  2056.     {$ELSE}
  2057.       VCL_CRYPTO_KEY_C
  2058.     {$ENDIF}
  2059.       ) > 0;
  2060.   {$ELSE}
  2061.     valid := GetTimeStampDaysLeft(
  2062.       INI_FILE_C,
  2063.       SECTION_C,
  2064.       STAMP_C,
  2065.     {$IFDEF IVVB}
  2066.       VB_CRYPTO_KEY_C
  2067.     {$ELSE}
  2068.       VCL_CRYPTO_KEY_C
  2069.     {$ENDIF}
  2070.       ) > 0;
  2071.   {$ENDIF}
  2072.  
  2073.     if not valid then
  2074.     begin
  2075.       dialog := TIvDemoDialog.CreateValue(nil, KEY_C);
  2076.       try
  2077.         dialog.ShowModal;
  2078.       finally
  2079.         dialog.Free;
  2080.       end;
  2081.     end;
  2082.   end;
  2083. {$ENDIF}
  2084. end;
  2085.  
  2086. procedure TIvDictionary.WriteDictionaryCode(writer: TWriter);
  2087. {$IFDEF IVBINARY}
  2088. var
  2089.   str: String;
  2090.   code: Integer;
  2091. {$ENDIF}
  2092. begin
  2093. {$IFDEF IVBINARY}
  2094.   try
  2095.     str := GetMLRegistryValue(DICTIONARY_CODE_C, '');
  2096.     code := StrToInt(str);
  2097.     if (code < Integer(Low(TIvLicense))) or (code > Integer(High(TIvLicense))) then
  2098.       raise Exception.Create('');
  2099.   except
  2100.     MessageDlg(
  2101.       'The Multilizer configuration is corrupted.'#13#10 +
  2102.       'Install Multilizer again!',
  2103.       mtInformation,
  2104.       [mbOK],
  2105.       0);
  2106.     code := Integer(liEvaluation);
  2107.   end;
  2108.   writer.WriteInteger(code);
  2109. {$ENDIF}
  2110. end;
  2111.  
  2112. procedure TIvDictionary.DefineProperties(filer: TFiler);
  2113. begin
  2114.   inherited DefineProperties(filer);
  2115.   filer.DefineProperty(
  2116.     'DictionaryCode',
  2117.     ReadDictionaryCode,
  2118.     WriteDictionaryCode,
  2119. {$IFDEF IVBINARY}
  2120.     True
  2121. {$ELSE}
  2122.     False
  2123. {$ENDIF}
  2124.     );
  2125. end;
  2126.  
  2127. class procedure TIvDictionary.SetTimeFormats(
  2128.   format: TIvTimeFormat;
  2129.   markPosition: TIvTimeMarkPosition;
  2130.   leadingZeros: Boolean;
  2131.   var shortTimeFormat, longTimeFormat: String);
  2132. var
  2133.   hourFormat, timePrefix, timePostfix: String;
  2134. begin
  2135.   if leadingZeros then
  2136.     hourFormat := 'hh'
  2137.   else
  2138.     hourFormat := 'h';
  2139.  
  2140.   timePostfix := '';
  2141.   timePrefix := '';
  2142.   if format = ivtf12 then
  2143.   begin
  2144.     case markPosition of
  2145.       ivtmSuffix: timePostfix := ' AMPM';
  2146.       ivtmPrefix: timePrefix := 'AMPM ';
  2147.     end;
  2148.   end;
  2149.  
  2150.   shortTimeFormat := timePrefix + hourFormat + ':mm' + timePostfix;
  2151.   longTimeFormat := timePrefix + hourFormat + ':mm:ss' + timePostfix;
  2152. end;
  2153.  
  2154. class function TIvDictionary.TranslateDateFormat(const formatStr: String): String;
  2155. var
  2156.   i: Integer;
  2157. {$IFDEF IVIME}
  2158.   CalType: Integer;
  2159.   Era, RemoveEra: Boolean;
  2160. {$ENDIF}
  2161. begin
  2162. {$IFDEF IVIME}
  2163.   I := 1;
  2164.   Result := '';
  2165.   CalType := StrToIntDef(GetLocaleStr(GetThreadLocale, LOCALE_ICALENDARTYPE, '1'), 1);
  2166.   Era := CalType in [CAL_JAPAN, CAL_TAIWAN, CAL_KOREA];
  2167.   if not Era then
  2168.   begin
  2169.     RemoveEra := SysLocale.PriLangID in [LANG_JAPANESE, LANG_CHINESE, LANG_KOREAN];
  2170.     if RemoveEra then
  2171.     begin
  2172.       While I <= Length(FormatStr) do
  2173.       begin
  2174.         if not (FormatStr[I] in ['g', 'G']) then
  2175.           Result := Result + FormatStr[I];
  2176.         Inc(I);
  2177.       end;
  2178.     end
  2179.     else
  2180.       Result := FormatStr;
  2181.     Exit;
  2182.   end;
  2183.  
  2184.   while I <= Length(FormatStr) do
  2185.   begin
  2186.     if FormatStr[I] in LeadBytes then
  2187.     begin
  2188.       Result := Result + Copy(FormatStr, I, 2);
  2189.       Inc(I, 2);
  2190.     end else
  2191.     begin
  2192.       if StrLIComp(@FormatStr[I], 'gg', 2) = 0 then
  2193.       begin
  2194.         Result := Result + 'ggg';
  2195.         Inc(I, 1);
  2196.       end
  2197.       else if StrLIComp(@FormatStr[I], 'yyyy', 4) = 0 then
  2198.       begin
  2199.         Result := Result + 'ee';
  2200.         Inc(I, 4-1);
  2201.       end
  2202.       else if StrLIComp(@FormatStr[I], 'yy', 2) = 0 then
  2203.       begin
  2204.         Result := Result + 'ee';
  2205.         Inc(I, 2-1);
  2206.       end
  2207.       else if FormatStr[I] in ['y', 'Y'] then
  2208.         Result := Result + 'e'
  2209.       else
  2210.         Result := Result + FormatStr[I];
  2211.       Inc(I);
  2212.     end;
  2213.   end;
  2214. {$ELSE}
  2215.   Result := formatStr;
  2216.   for i := 1 to Length(Result) do
  2217.     if Result[i] = '''' then
  2218.       Result[i] := '"';
  2219. {$ENDIF}
  2220. end;
  2221.  
  2222. procedure TIvDictionary.SynchronizeLocale;
  2223. var
  2224.   oldLocale: Integer;
  2225. begin
  2226.   { Sets the locale match the active language }
  2227.  
  2228.   if IsOpen then
  2229.   begin
  2230.     oldLocale := FActiveLocale;
  2231.     InitLocale(FLanguageData.DefaultLocale);
  2232.     if FActiveLocale <> oldLocale then
  2233.       LanguageChanged(False, True);
  2234.   end;
  2235. end;
  2236.  
  2237. procedure TIvDictionary.SynchronizeLanguage;
  2238. var
  2239.   oldLanguage: Integer;
  2240. begin
  2241.   { Sets the language match the active locale }
  2242.  
  2243.   if IsOpen then
  2244.   begin
  2245.     oldLanguage := FActiveLanguage;
  2246.     InitLanguage(LocaleToLanguage(FActiveLocale));
  2247.     if FActiveLanguage <> oldLanguage then
  2248.       LanguageChanged(True, False);
  2249.   end;
  2250. end;
  2251.  
  2252. procedure TIvDictionary.SetLanguage(value: Integer);
  2253. var
  2254.   oldLocale: Integer;
  2255. begin
  2256.   if not IsOpen then
  2257.     FLanguage := value
  2258.   else if (value < LANG_SYSTEM) or (value >= LanguageCount) then
  2259.     raise ERangeError.Create('Language index ' + IntToStr(value) + ' is out of range')
  2260.   else if value <> FLanguage then
  2261.   begin
  2262.     FLanguage := value;
  2263.  
  2264.     { Checks the language and accepts it }
  2265.  
  2266.     InitLanguage(FLanguage);
  2267.  
  2268.     { Updates the locale if the language and locale has been bound together }
  2269.  
  2270.     oldLocale := FActiveLocale;
  2271.  
  2272.     if FBinding = ivbiLocaleToLanguage then
  2273.       InitLocale(FLanguageData.ActiveLocale);
  2274.  
  2275.     { Updates the language }
  2276.  
  2277.     LanguageChanged(True, oldLocale <> FActiveLocale);
  2278.   end;
  2279. end;
  2280.  
  2281. procedure TIvDictionary.SetLocale(value: Integer);
  2282. var
  2283.   oldLanguage, newLanguage: Integer;
  2284. begin
  2285.   if not IsOpen then
  2286.     FLocale := value
  2287.   else if value <> FLocale then
  2288.   begin
  2289.     FLocale := value;
  2290.  
  2291.     { Checks the locale and accepts it }
  2292.  
  2293.     InitLocale(FLocale);
  2294.  
  2295.     { Updates the language if the language and locale has been bound together }
  2296.  
  2297.     oldLanguage := FActiveLanguage;
  2298.  
  2299.     if FBinding = ivbiLanguageToLocale then
  2300.     begin
  2301.       newLanguage := LocaleToLanguage(FActiveLocale);
  2302.       if newLanguage < 0 then
  2303.         InitLanguage(DefaultLanguage)
  2304.       else
  2305.       begin
  2306.         { Inits the language. However the default initialization sets the language
  2307.           locale to the default locale of the language. However, in this case
  2308.           the active locale is used. }
  2309.  
  2310.         InitLanguage(newLanguage);
  2311.         FLanguageLocale := FActiveLocale;
  2312.       end;
  2313.     end;
  2314.  
  2315.     LanguageChanged(oldLanguage <> FActiveLanguage, True);
  2316.   end;
  2317. end;
  2318.  
  2319. {
  2320. procedure TIvDictionary.InitLocale(locale: Integer);
  2321.  
  2322.  
  2323. begin
  2324.   if FBinding = ivbiLocaleToLanguage then
  2325.   begin
  2326.     if FOriginalLanguage = LANG_SYSTEM then
  2327.       locale := CheckLocale(GetSystemDefaultLCID, locale)
  2328.     else
  2329.       locale := CheckLocale(GetUserDefaultLCID, locale);
  2330.   end;
  2331. end;
  2332. }
  2333.  
  2334. procedure TIvDictionary.InitLanguage(language: Integer);
  2335. var
  2336.   primary, sub: Integer;
  2337.  
  2338.   function CheckLocale(systemLocale, defaultLocale: Integer): Integer;
  2339.   begin
  2340.     if IvGetPrimaryFromLocale(systemLocale) = IvGetPrimaryFromLocale(defaultLocale) then
  2341.       Result := systemLocale
  2342.     else
  2343.       Result := defaultLocale;
  2344.   end;
  2345.  
  2346. begin
  2347.   { Inits the language, the language data and the language locale }
  2348.  
  2349.   case language of
  2350.     LANG_SYSTEM: FActiveLanguage := LocaleToLanguage(GetSystemDefaultLCID);
  2351.     LANG_USER: FActiveLanguage := LocaleToLanguage(GetUserDefaultLCID);
  2352.   else
  2353.     FActiveLanguage := language;
  2354.   end;
  2355.  
  2356.   if FActiveLanguage < 0 then
  2357.     FActiveLanguage := DefaultLanguage;
  2358.   if FActiveLanguage = -1 then
  2359.     raise EIvMulti.Create('System does not support any language of the dicitonary!');
  2360.  
  2361.   FLanguageData.Free;
  2362.   FLanguageData := TIvLanguage.Create;
  2363.   if LanguageCount > 0 then
  2364.   begin
  2365.     { Gets first the language data of the native language }
  2366.  
  2367.     GetLanguageData(0, FLanguageData);
  2368.     sub := SUBLANG_NEUTRAL;
  2369.     case FLanguageData.CodePage of
  2370.       JAPANESE_CP_C: primary := LANG_JAPANESE;
  2371.  
  2372.       KOREAN_CP_C:
  2373.       begin
  2374.         primary := LANG_KOREAN;
  2375.         sub := SUBLANG_KOREAN;
  2376.       end;
  2377.  
  2378.       KOREAN_JOHAB_CP_C:
  2379.       begin
  2380.         primary := LANG_KOREAN;
  2381.         sub := SUBLANG_KOREAN_JOHAB;
  2382.       end;
  2383.  
  2384.       SIMPLIFIED_CHINESE_CP_C:
  2385.       begin
  2386.         primary := LANG_CHINESE;
  2387.         sub := SUBLANG_CHINESE_SIMPLIFIED;
  2388.       end;
  2389.  
  2390.       TRADITIONAL_CHINESE_CP_C:
  2391.       begin
  2392.         primary := LANG_CHINESE;
  2393.         sub := SUBLANG_CHINESE_TRADITIONAL;
  2394.       end;
  2395.     else
  2396.       primary := LANG_ENGLISH;
  2397.     end;
  2398.     FNativeLocale := IvMakeLangId(primary, sub);
  2399.  
  2400.     { Gets the language data }
  2401.  
  2402.     GetLanguageData(FActiveLanguage, FLanguageData);
  2403.     if FBinding = ivbiLocaleToLanguage then
  2404.     begin
  2405.       if FOriginalLanguage = LANG_SYSTEM then
  2406.         FLanguageData.ActiveSub := IvGetSubFromLocale(CheckLocale(
  2407.           GetSystemDefaultLCID,
  2408.           FLanguageData.DefaultLocale))
  2409.       else
  2410.         FLanguageData.ActiveSub := IvGetSubFromLocale(CheckLocale(
  2411.           GetUserDefaultLCID,
  2412.           FLanguageData.DefaultLocale));
  2413.     end;
  2414.   end;
  2415.  
  2416.   FLanguageLocale := FLanguageData.ActiveLocale;
  2417.  
  2418.   { Checks if Multilizer pro is required }
  2419.  
  2420.   if {(FEdition = edStandard) and }IvDoesLanguageRequirePro(FLanguageData.Primary) then
  2421.     raise EIvMulti.Create(
  2422.       'Professional edition of Multilizer is required for ' + FLanguageData.EnglishName);
  2423.  
  2424. {$IFDEF WIN32}
  2425.   { In the desing state the system support for the language is not checked }
  2426.  
  2427.   if not IsDesignTime then
  2428.   begin
  2429.     case FCheckLevel of
  2430.       ivclSystem:
  2431.         if not IsLanguageSupportedBySystem(FLanguageData) then
  2432.           raise EIvMulti.Create(
  2433.             FLanguageData.EnglishName + ' is not supported by the system');
  2434.  
  2435.       ivclCodePage:
  2436.         if not IsLanguageSupportedByCodePage(FLanguageData) then
  2437.           raise EIvMulti.Create(
  2438.             FLanguageData.EnglishName + ' is not supported by the code page');
  2439.     end;
  2440.   end;
  2441. {$ENDIF}
  2442. end;
  2443.  
  2444. procedure TIvDictionary.InitLocale(locale: Integer);
  2445. begin
  2446.   { Inits the active locale and the locale data }
  2447.  
  2448.   FActiveLocale := DecodeLocale(locale);
  2449.   FLocaleData.Free;
  2450.   FLocaleData := TIvLocale.Create;
  2451.   GetLocaleDataById(FActiveLocale, FLocaleData);
  2452.  
  2453.   { Checks if Multilizer pro is required }
  2454.  
  2455.   if {(FEdition = edStandard) and }IvDoesLanguageRequirePro(IvGetPrimaryFromLocale(locale)) then
  2456.     raise EIvMulti.Create(
  2457.       'Professional edition of Multilizer is required for this locale (' +
  2458.         IntToStr(IvGetPrimaryFromLocale(FActiveLocale)) + ')');
  2459.  
  2460. {$IFDEF WIN32}
  2461.   { In the desing state the system support for the locale is not checked }
  2462.  
  2463.   if not IsDesignTime then
  2464.   begin
  2465.     case FCheckLevel of
  2466.       ivclSystem:
  2467.         if not IvIsCodePageSupportedBySystem(FLocaleData.CodePage) then
  2468.           raise EIvMulti.Create(
  2469.             SysUtils.Format('The locale (%d, %d) is not supported by the system',
  2470.             [IvGetPrimaryFromLocale(locale), IvGetSubFromLocale(locale)]));
  2471.  
  2472.       ivclCodePage:
  2473.         if not IsLocaleSupportedByCodePage(FLocaleData) then
  2474.           raise EIvMulti.Create(
  2475.             SysUtils.Format('The locale (%d, %d) is not supported by the current code page',
  2476.             [IvGetPrimaryFromLocale(locale), IvGetSubFromLocale(locale)]));
  2477.     end;
  2478.   end;
  2479. {$ENDIF}
  2480. end;
  2481.  
  2482. function TIvDictionary.GetTranslationCount: Integer;
  2483. begin
  2484.   Result := 0;
  2485. end;
  2486.  
  2487. function TIvDictionary.GetTranslationMode: TIvTranslationMode;
  2488. begin
  2489.   Result := ivtmSingle;
  2490. end;
  2491.  
  2492. function TIvDictionary.TranslateString(
  2493.   const str: String;
  2494.   var translation: String): Boolean;
  2495. begin
  2496.   Result := TranslateContextString(str, '', '', translation);
  2497. end;
  2498.  
  2499. procedure TIvDictionary.TranslateStrings(translations: TList);
  2500. begin
  2501. end;
  2502.  
  2503. procedure TIvDictionary.SetEuro(value: TIvEuro);
  2504. begin
  2505.   FEuro := value;
  2506.   euroUsage := value;
  2507.   CurrencyString := LocaleData.EMUCurrencyString;
  2508. end;
  2509.  
  2510. procedure TIvDictionary.LanguageChanged(languageChanged, localeChanged: Boolean);
  2511. var
  2512.   i, day: Integer;
  2513.   str: String;
  2514.   rect: TRect;
  2515.   winPlacement: TWindowPlacement;
  2516. {$IFNDEF IVIME}
  2517.   size: Integer;
  2518. {$ENDIF}
  2519.  
  2520.   procedure Year2000(var str: String);
  2521.   begin
  2522.     if Pos('yyyy', str) = 0 then
  2523.       Insert('yy', str, Pos('yy', str));
  2524.   end;
  2525.  
  2526. begin
  2527.  
  2528.   if localeChanged then
  2529.   begin
  2530. {$IFDEF WIN32}
  2531.     SetThreadLocale(FActiveLocale);
  2532. {$ENDIF}
  2533.  
  2534.     if ivdoUpdateLocaleVariables in FOptions then
  2535.     begin
  2536.       { Updates standard VCL locale variables }
  2537.  
  2538. {$IFDEF IVWIDE}
  2539.       SysLocale.DefaultLCID := FLocaleData.Locale;
  2540.       SysLocale.PriLangID := FLocaleData.Primary;
  2541.       SysLocale.SubLangID := FLocaleData.Sub;
  2542.       SysLocale.FarEast := GetSystemMetrics(SM_DBCSENABLED) <> 0;
  2543. {$ENDIF}
  2544.  
  2545.       CurrencyString := FLocaleData.EMUCurrencyString;
  2546.       CurrencyFormat := Byte(FLocaleData.CurrencyFormat);
  2547.       NegCurrFormat := Byte(FLocaleData.NegCurrFormat);
  2548.       ThousandSeparator := FLocaleData.ThousandSeparator;
  2549.       DecimalSeparator := FLocaleData.DecimalSeparator;
  2550.       CurrencyDecimals := FLocaleData.CurrencyDecimals;
  2551.  
  2552.       DateSeparator := FLocaleData.DateSeparator;
  2553.       ShortDateFormat := FLocaleData.ShortDateFormat;
  2554.       LongDateFormat := FLocaleData.LongDateFormat;
  2555.  
  2556.       { ML can correct the year format short date using a four digits instead
  2557.         of two digits }
  2558.  
  2559.       if ivdoYear2000 in FOptions then
  2560.       begin
  2561.         Year2000(ShortDateFormat);
  2562.         Year2000(LongDateFormat);
  2563.       end;
  2564.  
  2565.       str := FLocaleData.TimeSeparator;
  2566.       if str <> '' then
  2567.         TimeSeparator := str[1]
  2568.       else
  2569.         TimeSeparator := ':';
  2570.       TimeAMString := FLocaleData.TimeAMString;
  2571.       TimePMString := FLocaleData.TimePMString;
  2572.  
  2573.       SetTimeFormats(
  2574.         FLocaleData.TimeFormat,
  2575.         FLocaleData.TimeMarkPosition,
  2576.         FLocaleData.TimeLeadingZeros,
  2577.         ShortTimeFormat,
  2578.         LongTimeFormat);
  2579.  
  2580.       for i := 1 to 12 do
  2581.       begin
  2582.         ShortMonthNames[i] := FLocaleData.ShortMonthNames[i];
  2583.         LongMonthNames[i] := FLocaleData.LongMonthNames[i];
  2584.       end;
  2585.  
  2586.       for i := 1 to 7 do
  2587.       begin
  2588.         { In VCL XxxxDayNames[1] is not Monday but Sunday }
  2589.  
  2590.         if i = 7 then
  2591.           day := 1
  2592.         else
  2593.           day := i + 1;
  2594.         ShortDayNames[day] := FLocaleData.ShortDayNames[i];
  2595.         LongDayNames[day] := FLocaleData.LongDayNames[i];
  2596.       end;
  2597.     end;
  2598.   end;
  2599.  
  2600.   { Makes all translators to translate themselves }
  2601.  
  2602.   if ivdoAutoTranslate in FOptions then
  2603.     for i := 0 to FTranslators.Count - 1 do
  2604.       TIvCustomTranslator(FTranslators.Items[i]).LanguageChanged(languageChanged, localeChanged);
  2605.  
  2606.   { Calls the events }
  2607.  
  2608.   if languageChanged and Assigned(FOnLanguageChange) then
  2609.     FOnLanguageChange(Self);
  2610.   if localeChanged and Assigned(FOnLocaleChange) then
  2611.     FOnLocaleChange(Self);
  2612.  
  2613.   { Force MDI to put back the system menu of a maximized child }
  2614.  
  2615.   if languageChanged and (Application.MainForm <> nil) and (Application.MainForm is TForm) then
  2616.   begin
  2617.     with TForm(Application.MainForm) do
  2618.     begin
  2619.       if (FormStyle = fsMDIForm) and (ActiveMDIChild <> nil) and (ActiveMDIChild.WindowState = wsMaximized) then
  2620.       begin
  2621.         { Save window dimension in normal state }
  2622.  
  2623.         if MDIChildCount = 1 then
  2624.         begin
  2625.           GetWindowPlacement(ActiveMDIChild.Handle, @winPlacement);
  2626.           rect := winPlacement.rcNormalPosition;
  2627.         end;
  2628.  
  2629. {$IFDEF IVIME}
  2630.         SendMessage(ActiveMDIChild.Handle, CM_RECREATEWND, 0, 0);
  2631. {$ELSE}
  2632.         size := ActiveMDIChild.ClientWidth + (Longint(ActiveMDIChild.ClientHeight) shl 16);
  2633.         SendMessage(ActiveMDIChild.Handle, WM_SIZE, SIZE_RESTORED, size);
  2634.         SendMessage(ActiveMDIChild.Handle, WM_SIZE, SIZE_MAXIMIZED, size);
  2635. {$ENDIF}
  2636.  
  2637.         { Set saved dimension after recreating window }
  2638.  
  2639.         if MDIChildCount = 1 then
  2640.         begin
  2641.           GetWindowPlacement(ActiveMDIChild.Handle, @winPlacement);
  2642.           winPlacement.rcNormalPosition := rect;
  2643.           SetWindowPlacement(ActiveMDIChild.Handle, @winPlacement);
  2644.         end;
  2645.       end;
  2646.     end;
  2647.   end;
  2648. end;
  2649.  
  2650. function TIvDictionary.GetDefaultLanguage: Integer;
  2651. var
  2652.   i, start: Integer;
  2653. begin
  2654.   { Gets the first language of the dictionary }
  2655.  
  2656.   if (LanguageCount = 0) or (Languages[0].Primary <> LANG_NEUTRAL) then
  2657.     start := 0
  2658.   else
  2659.     start := 1;
  2660.  
  2661.   { Gets the first language of the dictionary that is compatible with the
  2662.     current check level. }
  2663.  
  2664. {$IFDEF WIN32}
  2665.   Result := -1;
  2666.   for i := start to LanguageCount - 1 do
  2667.   begin
  2668.     case FCheckLevel of
  2669.       ivclNone:
  2670.         Result := i;
  2671.  
  2672.       ivclSystem:
  2673.         if IsLanguageSupportedBySystem(Languages[i]) then
  2674.           Result := i;
  2675.  
  2676.       ivclCodePage:
  2677.         if IsLanguageSupportedByCodePage(Languages[i]) then
  2678.           Result := i;
  2679.     end;
  2680.  
  2681.     if Result >= 0 then
  2682.       Break;
  2683.   end;
  2684. {$ELSE}
  2685.   Result := start;
  2686. {$ENDIF}
  2687. end;
  2688.  
  2689. function TIvDictionary.DecodeLocale(value: Integer): Integer;
  2690. begin
  2691.   if value = IvMakeLcId(IvMakeLangId(LANG_NEUTRAL, SUBLANG_DEFAULT), SORT_DEFAULT) then
  2692.     Result := GetUserDefaultLCID
  2693.   else if value = IvMakeLcId(IvMakeLangId(LANG_NEUTRAL, SUBLANG_SYS_DEFAULT), SORT_DEFAULT) then
  2694.     Result := GetSystemDefaultLCID
  2695.   else
  2696.     Result := value;
  2697. end;
  2698.  
  2699. function TIvDictionary.GetTranslatorCount: Integer;
  2700. begin
  2701.   Result := FTranslators.Count;
  2702. end;
  2703.  
  2704. function TIvDictionary.GetTranslator(i: Integer): TIvCustomTranslator;
  2705. begin
  2706.   Result := FTranslators.Items[i];
  2707. end;
  2708.  
  2709. function TIvDictionary.GetLanguage(i: Integer): TIvLanguage;
  2710. begin
  2711.   if i >= LanguageCount then
  2712.     raise ERangeError.Create('Out of language range');
  2713.  
  2714.   if i = FActiveLanguage then
  2715.     Result := FLanguageData
  2716.   else
  2717.   begin
  2718.     FTempLanguageData.Free;
  2719.     FTempLanguageData := TIvLanguage.Create;
  2720.     GetLanguageData(i, FTempLanguageData);
  2721.     Result := FTempLanguageData;
  2722.   end;
  2723. end;
  2724.  
  2725. function TIvDictionary.GetLocale(i: Integer): TIvLocale;
  2726. begin
  2727.   if i >= LocaleCount then
  2728.     raise ERangeError.Create('Out of locale range');
  2729.  
  2730.   FTempLocaleData.Free;
  2731.   FTempLocaleData := TIvLocale.Create;
  2732.   GetLocaleData(i, FTempLocaleData);
  2733.   Result := FTempLocaleData;
  2734. end;
  2735.  
  2736. function TIvDictionary.LocaleToLanguage(locale: Integer): Integer;
  2737. var
  2738.   i, j, primary, sub: Integer;
  2739.   list: TList;
  2740.   language: TIvLanguage;
  2741. begin
  2742.   if locale = IvMakeLcId(IvMakeLangId(LANG_NEUTRAL, SUBLANG_NEUTRAL), SORT_DEFAULT) then
  2743.   begin
  2744.     Result := 0;
  2745.     Exit;
  2746.   end;
  2747.  
  2748.   locale := DecodeLocale(locale);
  2749.   primary := IvGetPrimaryFromLocale(locale);
  2750.   sub := IvGetSubFromLocale(locale);
  2751.  
  2752.   { Gets all languages }
  2753.  
  2754.   list := TList.Create;
  2755.   GetLanguageDatas(list);
  2756.   try
  2757.     { Tries exact match }
  2758.  
  2759.     for i := 0 to list.Count - 1 do
  2760.     begin
  2761.       language := TIvLanguage(list[i]);
  2762.  
  2763.       if language.Primary = primary then
  2764.       begin
  2765.         { If either the default sub or one of the subs contains the
  2766.           given sub this language is used. }
  2767.  
  2768.         if language.DefaultSub = sub then
  2769.         begin
  2770.           Result := i;
  2771.           Exit;
  2772.         end;
  2773.  
  2774.         for j := 0 to language.SubCount - 1 do
  2775.           if sub = language.Subs[j] then
  2776.           begin
  2777.             Result := i;
  2778.             Exit;
  2779.           end;
  2780.       end;
  2781.     end;
  2782.  
  2783.     { Tries neutral match }
  2784.  
  2785.     for i := 0 to list.Count - 1 do
  2786.     begin
  2787.       language := TIvLanguage(list[i]);
  2788.  
  2789.       if (language.Primary = primary) and
  2790.         ((language.SubCount = 0) or (language.Subs[0] = SUBLANG_NEUTRAL)) then
  2791.       begin
  2792.         Result := i;
  2793.         Exit;
  2794.       end;
  2795.     end;
  2796.  
  2797.     { Tries primary only match }
  2798.  
  2799.     for i := 0 to list.Count - 1 do
  2800.     begin
  2801.       language := TIvLanguage(list[i]);
  2802.  
  2803.       if language.Primary = primary then
  2804.       begin
  2805.         Result := i;
  2806.         Exit;
  2807.       end;
  2808.     end;
  2809.  
  2810.     { No language matches the locale }
  2811.  
  2812.     Result := -1;
  2813.   finally
  2814.     FreeList(list);
  2815.   end;
  2816. end;
  2817.  
  2818. function TIvDictionary.IsLocaleSupported(locale: Integer): Boolean;
  2819. var
  2820.   i: Integer;
  2821.   list: TList;
  2822. begin
  2823.   Result := False;
  2824.  
  2825.   list := TList.Create;
  2826.   GetLocaleIds(list);
  2827.  
  2828.   for i := 0 to list.Count - 1 do
  2829.     if Integer(list[i]) = locale then
  2830.     begin
  2831.       Result := True;
  2832.       Break;
  2833.     end;
  2834.  
  2835.   list.Free;
  2836. end;
  2837.  
  2838. {$IFDEF WIN32}
  2839. class function TIvDictionary.GetCompareOptions(ignoreCase, ignoreSymbols: Boolean): Integer;
  2840. begin
  2841.   Result := 0;
  2842.   if ignoreCase then
  2843.     Result := NORM_IGNORECASE;
  2844.   //if ignoreSymbols then
  2845.   //  Result := NORM_IGNORESYMBOLS;
  2846. end;
  2847. {$ENDIF}
  2848.  
  2849. class function TIvDictionary.IvCompareText(
  2850.   const s1, s2: String;
  2851.   locale: Integer;
  2852.   ignoreSymbols: Boolean): Integer;
  2853. begin
  2854. {$IFDEF WIN32}
  2855.   Result := CompareString(
  2856.     locale,
  2857.     GetCompareOptions(True, ignoreSymbols),
  2858.     PChar(s1),
  2859.     Length(s1),
  2860.     PChar(s2),
  2861.     Length(s2)) - 2;
  2862. {$ELSE}
  2863.   Result := AnsiCompareText(s1, s2);
  2864. {$ENDIF}
  2865. end;
  2866.  
  2867. class function TIvDictionary.IvCompareStr(
  2868.   const s1, s2: String;
  2869.   locale: Integer;
  2870.   ignoreSymbols: Boolean): Integer;
  2871. begin
  2872. {$IFDEF WIN32}
  2873.   Result := CompareString(
  2874.     locale,
  2875.     GetCompareOptions(False, ignoreSymbols),
  2876.     PChar(s1),
  2877.     Length(s1),
  2878.     PChar(s2),
  2879.     Length(s2)) - 2;
  2880. {$ELSE}
  2881.   Result := AnsiCompareStr(s1, s2);
  2882. {$ENDIF}
  2883. end;
  2884.  
  2885. class function TIvDictionary.IvCompareBinary(const s1, s2: String): Integer;
  2886. var
  2887.   i, len, len1, len2: Integer;
  2888. begin
  2889.   len1 := Length(s1);
  2890.   len2 := Length(s2);
  2891.   if len1 < len2 then
  2892.     len := len1
  2893.   else
  2894.     len := len2;
  2895.  
  2896.   for i := 1 to len do
  2897.   begin
  2898.     if s1[i] < s2[i] then
  2899.     begin
  2900.       Result := -1;
  2901.       Exit;
  2902.     end
  2903.     else if s1[i] > s2[i] then
  2904.     begin
  2905.       Result := 1;
  2906.       Exit;
  2907.     end;
  2908.   end;
  2909.  
  2910.   if len1 = len2 then
  2911.     Result := 0
  2912.   else if len1 < len2 then
  2913.     Result := -1
  2914.   else
  2915.     Result := 1;
  2916. end;
  2917.  
  2918. {$IFDEF IVWIDE}
  2919. function IsNT: Boolean;
  2920. var
  2921.   versionInfo: TOSVersionInfo;
  2922. begin
  2923.   versionInfo.dwOSVersionInfoSize := Sizeof(versionInfo);
  2924.   GetVersionEx(versionInfo);
  2925.   Result := versionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT;
  2926. end;
  2927.  
  2928. class function TIvDictionary.IvWideCompareText(
  2929.   const s1, s2: WideString;
  2930.   locale: Integer;
  2931.   ignoreSymbols: Boolean): Integer;
  2932. var
  2933.   codePage: Integer;
  2934. begin
  2935.   if IsNT then
  2936.     Result := CompareStringW(
  2937.       locale,
  2938.       GetCompareOptions(True, ignoreSymbols),
  2939.       PWideChar(s1),
  2940.       Length(s1),
  2941.       PWideChar(s2),
  2942.       Length(s2)) - 2
  2943.   else
  2944.   begin
  2945.     codePage := IvLangIdToCodePage(locale);
  2946.     Result := IvCompareText(
  2947.       IvWStrToStr(s1, codePage),
  2948.       IvWStrToStr(s2, codePage),
  2949.       locale,
  2950.       ignoreSymbols);
  2951.   end;
  2952. end;
  2953.  
  2954. class function TIvDictionary.IvWideCompareStr(
  2955.   const s1, s2: WideString;
  2956.   locale: Integer;
  2957.   ignoreSymbols: Boolean): Integer;
  2958. var
  2959.   codePage: Integer;
  2960. begin
  2961.   if IsNT then
  2962.     Result := CompareStringW(
  2963.       locale,
  2964.       GetCompareOptions(False, ignoreSymbols),
  2965.       PWideChar(s1),
  2966.       Length(s1),
  2967.       PWideChar(s2),
  2968.       Length(s2)) - 2
  2969.   else
  2970.   begin
  2971.     codePage := IvLangIdToCodePage(locale);
  2972.     Result := IvCompareStr(
  2973.       IvWStrToStr(s1, codePage),
  2974.       IvWStrToStr(s2, codePage),
  2975.       locale,
  2976.       ignoreSymbols);
  2977.   end;
  2978. end;
  2979.  
  2980. class function TIvDictionary.IvWideCompareBinary(const s1, s2: WideString): Integer;
  2981. var
  2982.   i, len, len1, len2: Integer;
  2983. begin
  2984.   len1 := Length(s1);
  2985.   len2 := Length(s2);
  2986.   if len1 < len2 then
  2987.     len := len1
  2988.   else
  2989.     len := len2;
  2990.  
  2991.   for i := 1 to len do
  2992.   begin
  2993.     if s1[i] < s2[i] then
  2994.     begin
  2995.       Result := -1;
  2996.       Exit;
  2997.     end
  2998.     else if s1[i] > s2[i] then
  2999.     begin
  3000.       Result := 1;
  3001.       Exit;
  3002.     end;
  3003.   end;
  3004.  
  3005.   if len1 = len2 then
  3006.     Result := 0
  3007.   else if len1 < len2 then
  3008.     Result := -1
  3009.   else
  3010.     Result := 1;
  3011. end;
  3012. {$ENDIF}
  3013.  
  3014. function IvLangIdToCodePage(langId: Integer): Integer;
  3015. begin
  3016. {$IFDEF WIN32}
  3017.   Result := StrToInt(GetLocaleStr(IvMakeLcId(langId, 0), LOCALE_IDEFAULTANSICODEPAGE, '0'));
  3018.   if Result > 0 then
  3019.     Exit;
  3020. {$ENDIF}
  3021.  
  3022.   case IvGetPrimaryFromLocale(langId) of
  3023.     LANG_THAI:
  3024.       Result := THAI_CP_C;
  3025.  
  3026.     LANG_JAPANESE:
  3027.       Result := JAPANESE_CP_C;
  3028.  
  3029.     LANG_KOREAN:
  3030.       Result := KOREAN_CP_C;
  3031.  
  3032.     LANG_CHINESE:
  3033.       case IvGetSubFromLocale(langId) of
  3034.         SUBLANG_CHINESE_TRADITIONAL,
  3035.         SUBLANG_CHINESE_HONGKONG:
  3036.           Result := TRADITIONAL_CHINESE_CP_C
  3037.       else
  3038.         Result := SIMPLIFIED_CHINESE_CP_C;
  3039.       end;
  3040.  
  3041.     LANG_ALBANIAN,
  3042.     LANG_CZECH,
  3043.     LANG_HUNGARIAN,
  3044.     LANG_POLISH,
  3045.     LANG_ROMANIAN,
  3046.     LANG_SLOVAK,
  3047.     LANG_SLOVENIAN:
  3048.       Result := EAST_EUROPE_CP_C;
  3049.  
  3050.     LANG_BELARUSIAN,
  3051.     LANG_BULGARIAN,
  3052.     LANG_RUSSIAN,
  3053.     LANG_UKRAINIAN:
  3054.       Result := CYRILLIC_CP_C;
  3055.  
  3056.     {LANG_SERBIAN,}
  3057.     LANG_CROATIAN:
  3058.       case IvGetSubFromLocale(langId) of
  3059.         SUBLANG_DEFAULT,
  3060.         SUBLANG_SERBIAN_LATIN:
  3061.           Result := EAST_EUROPE_CP_C;
  3062.       else
  3063.         Result := CYRILLIC_CP_C;
  3064.       end;
  3065.  
  3066.     LANG_GREEK:
  3067.       Result := GREEK_CP_C;
  3068.  
  3069.     LANG_TURKISH:
  3070.       Result := TURKISH_CP_C;
  3071.  
  3072.     LANG_HEBREW:
  3073.       Result := HEBREW_CP_C;
  3074.  
  3075.     LANG_FARSI,
  3076.     LANG_ARABIC:
  3077.       Result := ARABIC_CP_C;
  3078.  
  3079.     LANG_ESTONIAN,
  3080.     LANG_LATVIAN,
  3081.     LANG_LITHUANIAN:
  3082.       Result := BALTIC_CP_C;
  3083.  
  3084.     LANG_VIETNAMESE:
  3085.       Result := VIETNAMESE_CP_C;
  3086.   else
  3087.     Result := WESTERN_CP_C;
  3088.   end;
  3089. end;
  3090.  
  3091. {$IFDEF WIN32}
  3092. class function TIvDictionary.IsLanguageSupportedBySystem(language: TIvLanguage): Boolean;
  3093. begin
  3094.   { Language is supported by system if it uses only standard ASCII or it uses
  3095.     the same code page as the system. }
  3096.  
  3097.   Result :=
  3098.     (language.Primary = LANG_NEUTRAL) or
  3099.     (language.Primary = LANG_ENGLISH) or
  3100.     (language.Primary = LANG_INDONESIAN) or
  3101.     (ivloPureASCII in language.Options) or
  3102.     IvIsCodePageSupportedBySystem(language.CodePage);
  3103. end;
  3104.  
  3105. class function TIvDictionary.IsLanguageSupportedByCodePage(language: TIvLanguage): Boolean;
  3106. begin
  3107.   { Language is supported by the code page if it uses only standard ASCII or
  3108.     it is compatible with the current code page. }
  3109.  
  3110.   Result :=
  3111.     (language.Primary = LANG_NEUTRAL) or
  3112.     (language.Primary = LANG_ENGLISH) or
  3113.     (language.Primary = LANG_INDONESIAN) or
  3114.     (ivloPureASCII in language.Options) or
  3115.     (language.CodePage = 0) or
  3116.     (language.CodePage = Integer(GetACP));
  3117. end;
  3118.  
  3119. class function TIvDictionary.IsLocaleSupportedBySystem(locale: TIvLocale): Boolean;
  3120. begin
  3121.   { Locale is supported by system if it uses only standard ASCII or it uses
  3122.     the same code page as the system. }
  3123.  
  3124.   Result :=
  3125.     (locale.Primary = LANG_NEUTRAL) or
  3126.     (locale.Primary = LANG_ENGLISH) or
  3127.     (locale.Primary = LANG_INDONESIAN) or
  3128.     IvIsCodePageSupportedBySystem(locale.CodePage);
  3129. end;
  3130.  
  3131. class function TIvDictionary.IsLocaleSupportedByCodePage(locale: TIvLocale): Boolean;
  3132. begin
  3133.   { Locale is supported by the code page if it uses only standard ASCII or
  3134.     it is compatible with the current code page. }
  3135.  
  3136.   Result :=
  3137.     (locale.Primary = LANG_NEUTRAL) or
  3138.     (locale.Primary = LANG_ENGLISH) or
  3139.     (locale.Primary = LANG_INDONESIAN) or
  3140.     (locale.CodePage = Integer(GetACP));
  3141. end;
  3142.  
  3143. function IvIsCodePageSupportedBySystem(codePage: Integer): Boolean;
  3144.  
  3145.   function EnumCodePages(locale: PChar): Integer; stdcall;
  3146.   begin
  3147.     if StrToInt(locale) = enumInteger then
  3148.       supported := True;
  3149.     Result := 1;
  3150.   end;
  3151.  
  3152. begin
  3153.   if codePage = 0 then
  3154.     Result := True
  3155.   else
  3156.   begin
  3157.     enumInteger := codePage;
  3158.     supported := False;
  3159.     EnumSystemCodePages(@EnumCodePages, CP_SUPPORTED);
  3160.     Result := supported;
  3161.   end;
  3162. end;
  3163.  
  3164. function IvIsLocaleSupportedByCodePage(locale: Integer): Boolean;
  3165. var
  3166.   primary, codePage: Integer;
  3167. begin
  3168.   primary := IvGetPrimaryFromLocale(locale);
  3169.   if primary = LANG_NEUTRAL then
  3170.     Result := True
  3171.   else
  3172.   begin
  3173.     codePage := StrToInt(GetLocaleStr(locale, LOCALE_IDEFAULTANSICODEPAGE, '0'));
  3174.     Result :=
  3175.       (primary = LANG_ENGLISH) or
  3176.       (primary = LANG_INDONESIAN) or
  3177.       (Integer(GetACP) = codePage);
  3178.   end;
  3179. end;
  3180.  
  3181. function TIvDictionary.CompareText(const s1, s2: String): Integer;
  3182. begin
  3183.   Result := IvCompareText(s1, s2, LanguageLocale, False);
  3184. end;
  3185.  
  3186. function TIvDictionary.CompareStr(const s1, s2: String): Integer;
  3187. begin
  3188.   Result := IvCompareStr(s1, s2, LanguageLocale, False);
  3189. end;
  3190. {$ENDIF}
  3191.  
  3192. function TIvDictionary.IsOpen: Boolean;
  3193. begin
  3194.   Result := FOpen;
  3195. end;
  3196.  
  3197. function TIvDictionary.CanBeOpened: Boolean;
  3198. begin
  3199.   Result := True;
  3200. end;
  3201.  
  3202. procedure TIvDictionary.Open;
  3203. var
  3204.   language: Integer;
  3205. {$IFDEF IVWIDE}
  3206.   {$IFNDEF IVVB}
  3207.   protect: Integer;
  3208.   {$ENDIF}
  3209. {$ENDIF}
  3210. begin
  3211.   if IsOpen or not CanBeOpened then
  3212.     Exit;
  3213.  
  3214.   FOriginalLanguage := FLanguage;
  3215.   try
  3216.     { Sets the initial language and locale }
  3217.  
  3218.     case FBinding of
  3219.       ivbiNone:
  3220.       begin
  3221.         { Language and locale are not connected. Sets both separately.}
  3222.  
  3223.         InitLanguage(FLanguage);
  3224.         InitLocale(FLocale);
  3225.       end;
  3226.  
  3227.       ivbiLocaleToLanguage:
  3228.       begin
  3229.         { Locale is connected to the language. Sets the language first and
  3230.           sets then the locale to the default locale of the language. }
  3231.  
  3232.         InitLanguage(FLanguage);
  3233.         InitLocale(FLanguageData.ActiveLocale);
  3234.       end;
  3235.  
  3236.       ivbiLanguageToLocale:
  3237.       begin
  3238.         { Language is connected to the locale. Sets the locale first. Then
  3239.           check if the dictionary contains the language of the locale. If does
  3240.           sets that language on. Otherwise sets the default language. }
  3241.  
  3242.         InitLocale(FLocale);
  3243.  
  3244.         language := LocaleToLanguage(FActiveLocale);
  3245.         if language < 0 then
  3246.           InitLanguage(DefaultLanguage)
  3247.         else
  3248.         begin
  3249.           { The InitLanguage sets the language locale to the default locale of
  3250.             the language.
  3251.             However, in this case the active locale is used. }
  3252.  
  3253.           InitLanguage(language);
  3254.           FLanguageLocale := FActiveLocale;
  3255.         end;
  3256.       end;
  3257.     end;
  3258.  
  3259. {$IFDEF IVWIDE}
  3260.   {$IFNDEF IVVB}
  3261.     { Automatic resource string translation is turned on only when the
  3262.       application is statically linked (e.g. does not use packages) }
  3263.  
  3264.     if not IsDesignTime and
  3265.       not loadResStringChanged and
  3266.       (ivdoTranslateResourceStrings in FOptions) and
  3267.       (LibModuleList.Next = nil) then
  3268.     begin
  3269.       VirtualProtect(@LoadResString, 34, PAGE_READWRITE, @protect);
  3270.       Move((@LoadResString)^, resStringBuffer, 34);
  3271.       Move((@IvLoadResString)^, (@LoadResString)^, 34);
  3272.       VirtualProtect(@LoadResString, 34, protect, @protect);
  3273.  
  3274.       VirtualProtect(@ShortCutToText, 34, PAGE_READWRITE, @protect);
  3275.       Move((@ShortCutToText)^, shortCutBuffer, 34);
  3276.       Move((@IvShortCutToText)^, (@ShortCutToText)^, 34);
  3277.       VirtualProtect(@ShortCutToText, 34, protect, @protect);
  3278.  
  3279.       loadResStringChanged := True;
  3280.     end;
  3281.   {$ENDIF}
  3282. {$ENDIF}
  3283.  
  3284. {$IFDEF IVBINARY}
  3285.     if FDictionaryCode = Integer(liLimited) then
  3286.     begin
  3287.       if LanguageCount > LIMITED_VERSION_LANGAUGE_COUNT_C then
  3288.       begin
  3289.         Close;
  3290.         raise EIvMulti.Create(Format(
  3291.           'The maximum language count of the limited version is %d.',
  3292.           [LIMITED_VERSION_LANGAUGE_COUNT_C]));
  3293.       end;
  3294.  
  3295.       if TranslationCount > LIMITED_VERSION_TRANSLATION_COUNT_C then
  3296.       begin
  3297.         Close;
  3298.         raise EIvMulti.Create(Format(
  3299.           'The maximum translation count of the limited version is %d.',
  3300.           [LIMITED_VERSION_TRANSLATION_COUNT_C]));
  3301.       end;
  3302.     end;
  3303. {$ENDIF}
  3304.  
  3305.     { Updates the language }
  3306.  
  3307.     FOpen := True; { This must be called before LanguageChanged }
  3308.     LanguageChanged(True, True);
  3309.   except
  3310.     Close;
  3311.     raise;
  3312.   end;
  3313. end;
  3314.  
  3315. procedure TIvDictionary.Close;
  3316. {$IFDEF IVWIDE}
  3317.   {$IFNDEF IVVB}
  3318. var
  3319.   protect: Integer;
  3320.   {$ENDIF}
  3321. {$ENDIF}
  3322. begin
  3323. {$IFDEF IVWIDE}
  3324.   {$IFNDEF IVVB}
  3325.   if not IsDesignTime and loadResStringChanged then
  3326.   begin
  3327.     VirtualProtect(@LoadResString, 34, PAGE_READWRITE, @protect);
  3328.     Move(resStringBuffer, (@LoadResString)^, 34);
  3329.     VirtualProtect(@LoadResString, 34, protect, @protect);
  3330.  
  3331.     VirtualProtect(@ShortCutToText, 34, PAGE_READWRITE, @protect);
  3332.     Move(shortCutBuffer, (@ShortCutToText)^, 34);
  3333.     VirtualProtect(@ShortCutToText, 34, protect, @protect);
  3334.  
  3335.     loadResStringChanged := False;
  3336.   end;
  3337.   {$ENDIF}
  3338. {$ENDIF}
  3339.  
  3340.   UnbindTranslators;
  3341.   FOpen := False;
  3342. end;
  3343.  
  3344. procedure TIvDictionary.UnbindTranslators;
  3345. begin
  3346.   { Unbinds all transaltors from the dictionary }
  3347.  
  3348.   while FTranslators.Count > 0 do
  3349.     TIvCustomTranslator(FTranslators[0]).Unbind;
  3350. end;
  3351.  
  3352. procedure TIvDictionary.AddTranslator(translator: TIvCustomTranslator);
  3353. var
  3354.   i: Integer;
  3355. begin
  3356.   { Adds the given translator to the translator list if it does not
  3357.     already exist there. }
  3358.  
  3359.   for i := 0 to FTranslators.Count - 1 do
  3360.     if FTranslators.Items[i] = translator then
  3361.       Exit;
  3362.   FTranslators.Add(translator);
  3363. end;
  3364.  
  3365. procedure TIvDictionary.RemoveTranslator(translator: TIvCustomTranslator);
  3366. begin
  3367.   { Removes the given translator from the translator list. }
  3368.  
  3369.   FTranslators.Remove(translator);
  3370. end;
  3371.  
  3372. function TIvDictionary.DoesTranslationExist(const str: String): Boolean;
  3373. var
  3374.   translation: String;
  3375. begin
  3376.   Result := TranslateString(str, translation);
  3377. end;
  3378.  
  3379. function TIvDictionary.DoesContextTranslationExist(const str, form, component: String): Boolean;
  3380. var
  3381.   translation: String;
  3382. begin
  3383.   Result := TranslateContextString(str, form, component, translation);
  3384. end;
  3385.  
  3386. function Translate(const str: String): String;
  3387. begin
  3388.   if Dictionaries.Count = 0 then
  3389.     Result := str
  3390.   else
  3391.     Result := Dictionaries[0].Translate(str);
  3392. end;
  3393.  
  3394. function TranslateContext(const str, form, component: String): String;
  3395. begin
  3396.   if Dictionaries.Count = 0 then
  3397.     Result := str
  3398.   else
  3399.     Result := Dictionaries[0].TranslateContext(str, form, component);
  3400. end;
  3401.  
  3402. function GetDefaultDictionary: TIvDictionary;
  3403. begin
  3404.   if Dictionaries.Count = 0 then
  3405.     Result := nil
  3406.   else
  3407.     Result := Dictionaries[0];
  3408. end;
  3409.  
  3410. function TIvDictionary.Translate(const str: String): String;
  3411. var
  3412.   ok: Boolean;
  3413.   translation: String;
  3414. begin
  3415.   Result := str;
  3416.   if Self = nil then
  3417.     Exit;
  3418.  
  3419.   if str <> '' then
  3420.   begin
  3421.     ok := TranslateString(str, translation);
  3422.     Result := CheckTranslation(str, translation, ok);
  3423.   end;
  3424. end;
  3425.  
  3426. function TIvDictionary.TranslateContext(const str, form, component: String): String;
  3427. var
  3428.   ok: Boolean;
  3429.   translation: String;
  3430. begin
  3431.   Result := str;
  3432.   if Self = nil then
  3433.     Exit;
  3434.  
  3435.   { Translates the string }
  3436.  
  3437.   if str = '' then
  3438.   begin
  3439.     ok := True;
  3440.     translation := '';
  3441.   end
  3442.   else if ContextType = [] then
  3443.     ok := TranslateString(str, translation)
  3444.   else
  3445.   begin
  3446.     { Tries first to translate with the context information.
  3447.       If not found translates without the context information. }
  3448.  
  3449.     ok := TranslateContextString(str, form, component, translation);
  3450.     if not ok then
  3451.       ok := TranslateString(str, translation);
  3452.   end;
  3453.  
  3454.   Result := CheckTranslation(str, translation, ok);
  3455. end;
  3456.  
  3457. function TIvDictionary.CheckTranslation(
  3458.   const native, translation: String;
  3459.   ok: Boolean): String;
  3460. const
  3461.   TAG_C = '@';
  3462. begin
  3463.   if ok then
  3464.   begin
  3465.     { The translation was found from the dictionary. }
  3466.  
  3467.     if translation <> '' then
  3468.       Result := translation
  3469.     else
  3470.       case FMissingTranslation of
  3471.         ivmtUseNative:
  3472.           Result := native;
  3473.  
  3474.         ivmtUseNull:
  3475.           Result := '';
  3476.  
  3477.         ivmtTagNative:
  3478.           Result := TAG_C + native + TAG_C;
  3479.  
  3480.         ivmtRaiseException:
  3481.           raise EIvMulti.Create('Translation for the word "' + native + '" is missing')
  3482.       end;
  3483.   end
  3484.   else
  3485.   begin
  3486.     { The translation was not found from the dictionary. }
  3487.  
  3488.     case FMissingTranslation of
  3489.       ivmtUseNative:
  3490.         Result := native;
  3491.  
  3492.       ivmtUseNull:
  3493.         Result := '';
  3494.  
  3495.       ivmtTagNative:
  3496.         Result := TAG_C + native + TAG_C;
  3497.  
  3498.       ivmtRaiseException:
  3499.         raise EIvMulti.Create('Dictionary does not contain a translation for the word "' + native + '"')
  3500.     end;
  3501.   end;
  3502. end;
  3503.  
  3504. class function TIvDictionary.ComposeLanguageName(
  3505.   language: String;
  3506.   primary, codePage: Integer;
  3507.   translate: Boolean;
  3508.   dictionary: TIvDictionary): String;
  3509. var
  3510.   str: String;
  3511.   parser: TIvStringParser;
  3512. begin
  3513.   if translate and (dictionary = nil) then
  3514.     dictionary := GetDefaultDictionary;
  3515.  
  3516.   parser := TIvStringParser.CreateValue(language, ' ');
  3517.  
  3518.   if (primary = LANG_NORWEGIAN) or (primary = LANG_SPANISH) then
  3519.   begin
  3520.     parser.Separator := ' ';
  3521.     Result := parser.GetString;
  3522.     if translate then
  3523.       Result := dictionary.Translate(Result);
  3524.   end
  3525.   else if (primary = LANG_CHINESE) or (primary = LANG_KOREAN) then
  3526.   begin
  3527.     parser.Separator := '(';
  3528.     Result := parser.GetString;
  3529.     if translate then
  3530.       Result := dictionary.Translate(Result);
  3531.     if primary = LANG_CHINESE then
  3532.     begin
  3533.       if codePage = TRADITIONAL_CHINESE_CP_C then
  3534.         str := 'Traditional'
  3535.       else
  3536.         str := 'Simplified';
  3537.       if translate then
  3538.         str := dictionary.Translate(str);
  3539.       Result := Result + ', ' + str;
  3540.     end;
  3541.     if primary = LANG_KOREAN then
  3542.     begin
  3543.       if codePage = KOREAN_JOHAB_CP_C then
  3544.       begin
  3545.         str := 'Johab';
  3546.         if translate then
  3547.           str := dictionary.Translate(str);
  3548.         Result := Result + ', ' + str;
  3549.       end;
  3550.     end;
  3551.   end
  3552.   else
  3553.   begin
  3554.     Result := language;
  3555.     if translate then
  3556.       Result := dictionary.Translate(Result);
  3557.   end;
  3558.  
  3559.   parser.Free;
  3560. end;
  3561.  
  3562. class function TIvDictionary.ComposeCountryName(
  3563.   country: String;
  3564.   primary, sub: Integer;
  3565.   translate: Boolean;
  3566.   dictionary: TIvDictionary): String;
  3567. begin
  3568.   if translate and (dictionary = nil) then
  3569.     dictionary := GetDefaultDictionary;
  3570.  
  3571.   Result := country;
  3572.   if primary = LANG_NORWEGIAN then
  3573.   begin
  3574.     if sub = SUBLANG_NORWEGIAN_BOKMAL then
  3575.       Result := 'Bokmal'
  3576.     else if sub = SUBLANG_NORWEGIAN_NYNORSK then
  3577.       Result := 'Nynorsk';
  3578.   end
  3579.   else if primary = LANG_KOREAN then
  3580.   begin
  3581.     if sub = SUBLANG_KOREAN_JOHAB then
  3582.       Result := 'Johab';
  3583.   end;
  3584.  
  3585.   if translate then
  3586.     Result := dictionary.Translate(Result);
  3587. end;
  3588.  
  3589. class function TIvDictionary.ComposeLocaleName(
  3590.   language, country: String;
  3591.   primary, sub, codePage: Integer;
  3592.   translate: Boolean;
  3593.   dictionary: TIvDictionary): String;
  3594. var
  3595.   str: String;
  3596.   parser: TIvStringParser;
  3597. begin
  3598.   if translate and (dictionary = nil) then
  3599.     dictionary := GetDefaultDictionary;
  3600.  
  3601.   parser := TIvStringParser.CreateValue(language, ' ');
  3602.   if primary = LANG_NORWEGIAN then
  3603.   begin
  3604.     parser.Separator := ' ';
  3605.     Result := parser.GetString;
  3606.     if sub = SUBLANG_NORWEGIAN_BOKMAL then
  3607.       country := 'Bokmal'
  3608.     else if sub = SUBLANG_NORWEGIAN_NYNORSK then
  3609.       country := 'Nynorsk';
  3610.  
  3611.     if translate then
  3612.       Result := dictionary.Translate(Result);
  3613.   end
  3614.   else if primary = LANG_SPANISH then
  3615.   begin
  3616.     parser.Separator := ' ';
  3617.     Result := parser.GetString;
  3618.  
  3619.     if translate then
  3620.       Result := dictionary.Translate(Result);
  3621.   end
  3622.   else if primary = LANG_SERBIAN then
  3623.   begin
  3624.     parser.Separator := ' ';
  3625.     Result := parser.GetString;
  3626.     if sub = SUBLANG_DEFAULT then
  3627.       Result := 'Croatian'
  3628.     else if sub = SUBLANG_SERBIAN_LATIN then
  3629.       Result := 'Serbian-Latin'
  3630.     else if sub = SUBLANG_SERBIAN_CYRILLIC then
  3631.       Result := 'Serbian';
  3632.  
  3633.     if translate then
  3634.       Result := dictionary.Translate(Result);
  3635.   end
  3636.   else if primary = LANG_CHINESE then
  3637.   begin
  3638.     parser.Separator := '(';
  3639.     Result := parser.GetString;
  3640.     if translate then
  3641.       Result := dictionary.Translate(Result);
  3642.  
  3643.     if codePage <> 0 then
  3644.     begin
  3645.       if codePage = TRADITIONAL_CHINESE_CP_C then
  3646.         str := 'Traditional'
  3647.       else
  3648.         str := 'Simplified';
  3649.     end;
  3650.  
  3651.     if translate then
  3652.       str := dictionary.Translate(str);
  3653.     Result := Result + ', ' + str;
  3654.   end
  3655.   else if primary = LANG_KOREAN then
  3656.   begin
  3657.     parser.Separator := '(';
  3658.     Result := parser.GetString;
  3659.     if translate then
  3660.       Result := dictionary.Translate(Result);
  3661.  
  3662.     if codePage <> 0 then
  3663.     begin
  3664.       if codePage = KOREAN_JOHAB_CP_C then
  3665.       begin
  3666.         str := 'Johab';
  3667.         if translate then
  3668.           str := dictionary.Translate(str);
  3669.         Result := Result + ', ' + str;
  3670.       end;
  3671.     end;
  3672.  
  3673.     if sub = SUBLANG_KOREAN_JOHAB then
  3674.       country := 'Johab';
  3675.   end
  3676.   else
  3677.   begin
  3678.     Result := language;
  3679.     if translate then
  3680.       Result := dictionary.Translate(Result);
  3681.   end;
  3682.  
  3683.   if sub <> SUBLANG_NEUTRAL then
  3684.   begin
  3685.     if translate then
  3686.       country := dictionary.Translate(country);
  3687.     Result := Result + ' (' +  country + ')';
  3688.   end;
  3689.  
  3690.   parser.Free;
  3691. end;
  3692.  
  3693. procedure TIvDictionary.GetLanguageDatas(list: TList);
  3694. var
  3695.   i, count: Integer;
  3696.   language: TIvLanguage;
  3697. begin
  3698.   count := GetLanguageCount;
  3699.   for i := 0 to count - 1 do
  3700.   begin
  3701.     language := TIvLanguage.Create;
  3702.     GetLanguageData(i, language);
  3703.     list.Add(language);
  3704.   end;
  3705. end;
  3706.  
  3707. procedure TIvDictionary.GetLocaleDatas(list: TList);
  3708. var
  3709.   i, count: Integer;
  3710.   locale: TIvLocale;
  3711. begin
  3712.   count := GetLocaleCount;
  3713.   for i := 0 to count - 1 do
  3714.   begin
  3715.     locale := TIvLocale.Create;
  3716.     GetLocaleData(i, locale);
  3717.     list.Add(locale);
  3718.   end;
  3719. end;
  3720.  
  3721. {$IFDEF WIN32}
  3722. class function TIvDictionary.GetSystemLocaleData(id: Integer; locale: TIvLocale): Boolean;
  3723. const
  3724.   TAG_C = '@*';
  3725. var
  3726.   i: Integer;
  3727. begin
  3728.   Result := False;
  3729.   if GetLocaleStr(id, LOCALE_SENGLANGUAGE, TAG_C) = TAG_C then
  3730.     Exit;
  3731.  
  3732.   { Finds from the NLS database }
  3733.  
  3734.   locale.Primary := IvGetPrimaryFromLocale(id);
  3735.   locale.Sub := IvGetSubFromLocale(id);
  3736.   locale.CodePage := StrToInt(GetLocaleStr(id, LOCALE_IDEFAULTANSICODEPAGE, '1252'));
  3737. {$IFDEF WIN32}
  3738.   locale.Charset := IvCodePageToCharset(locale.CodePage);
  3739. {$ENDIF}
  3740.   locale.IsCustom := False;
  3741.  
  3742.   locale.EnglishLanguageName := GetLocaleStr(id, LOCALE_SENGLANGUAGE, '');
  3743.   locale.EnglishCountryName := GetLocaleStr(id, LOCALE_SENGCOUNTRY, '');
  3744.   locale.NativeLanguageName := GetLocaleStr(id, LOCALE_SNATIVELANGNAME, '');
  3745.   locale.NativeCountryName := GetLocaleStr(id, LOCALE_SNATIVECTRYNAME, '');
  3746.   locale.Win16LanguageName := GetLocaleStr(id, LOCALE_SABBREVLANGNAME, '');
  3747.   locale.Win16CountryName := GetLocaleStr(id, LOCALE_SCOUNTRY, '');
  3748.  
  3749.   locale.MeasurementSystem := TIvMeasurementSystem(StrToInt(GetLocaleStr(id, LOCALE_IMEASURE, '0')));
  3750.   locale.CurrencyString := GetLocaleStr(id, LOCALE_SCURRENCY, '');
  3751.   locale.CurrencyFormat := TIvCurrencyFormat(StrToInt(GetLocaleStr(id, LOCALE_ICURRENCY, '0')));
  3752.   locale.NegCurrFormat := TIvNegativeCurrencyFormat(StrToInt(GetLocaleStr(id, LOCALE_INEGCURR, '0')));
  3753.   locale.CurrencyDecimals := StrToInt(GetLocaleStr(id, LOCALE_ICURRDIGITS, '0'));
  3754.   locale.ThousandSeparator := GetLocaleStr(id, LOCALE_STHOUSAND, ' ')[1];
  3755.   locale.DecimalSeparator := GetLocaleStr(id, LOCALE_SDECIMAL, ' ')[1];
  3756.  
  3757.   locale.DateSeparator := GetLocaleStr(id, LOCALE_SDATE, ' ')[1];
  3758.   locale.ShortDateFormat := GetLocaleStr(id, LOCALE_SSHORTDATE, '');
  3759.   locale.LongDateFormat := GetLocaleStr(id, LOCALE_SLONGDATE, '');
  3760.  
  3761.   locale.TimeSeparator := GetLocaleStr(id, LOCALE_STIME, ' ')[1];
  3762.   locale.TimeAMString := GetLocaleStr(id, LOCALE_S1159, '');
  3763.   locale.TimePMString := GetLocaleStr(id, LOCALE_S2359, '');
  3764.   locale.TimeLeadingZeros := GetLocaleStr(id, LOCALE_ITLZERO, '0') <> '0';
  3765.   locale.TimeFormat := TIvTimeFormat(StrToInt(GetLocaleStr(id, LOCALE_ITIME, '0')));
  3766.   locale.TimeMarkPosition := TIvTimeMarkPosition(StrToInt(GetLocaleStr(id, LOCALE_ITIMEMARKPOSN, '0')));
  3767.  
  3768.   locale.CalendarType := TIvCalendarType(StrToInt(GetLocaleStr(id, LOCALE_ICALENDARTYPE, '0')));
  3769.   locale.OptionalCalendarType := TIvCalendarType(StrToInt(GetLocaleStr(id, LOCALE_IOPTIONALCALENDAR, '0')));
  3770.   locale.FirstDayOfWeek := TIvDayOfWeek(StrToInt(GetLocaleStr(id, LOCALE_IFIRSTDAYOFWEEK, '0')));
  3771.   locale.FirstWeekOfYear := TIvFirstWeekOfYear(StrToInt(GetLocaleStr(id, LOCALE_IFIRSTWEEKOFYEAR, '0')));
  3772.  
  3773.   for i := 1 to 7 do
  3774.   begin
  3775.     locale.ShortDayNames[i] := GetLocaleStr(id, LOCALE_SABBREVDAYNAME1 + i - 1, '');
  3776.     locale.LongDayNames[i] := GetLocaleStr(id, LOCALE_SDAYNAME1 + i - 1, '');
  3777.   end;
  3778.  
  3779.   for i := 1 to 12 do
  3780.   begin
  3781.     locale.ShortMonthNames[i] := GetLocaleStr(id, LOCALE_SABBREVMONTHNAME1 + i - 1, '');
  3782.     locale.LongMonthNames[i] := GetLocaleStr(id, LOCALE_SMONTHNAME1 + i - 1, '');
  3783.   end;
  3784.  
  3785.   locale.Init;
  3786.   
  3787.   Result := True;
  3788. end;
  3789. {$ENDIF}
  3790.  
  3791. function TIvDictionary.GetLocaleDataById(id: Integer; locale: TIvLocale): Boolean;
  3792. var
  3793.   i: Integer;
  3794.   locales: TList;
  3795. begin
  3796.   { Finds first from the locale table }
  3797.  
  3798.   locales := TList.Create;
  3799.   try
  3800.     GetLocaleDatas(locales);
  3801.     for i := 0 to locales.Count - 1 do
  3802.     begin
  3803.       if TIvLocale(locales[i]).Locale = id then
  3804.       begin
  3805.         locale.Assign(locales[i]);
  3806.         Result := True;
  3807.         Exit;
  3808.       end;
  3809.     end;
  3810.   finally
  3811.     FreeList(locales);
  3812.   end;
  3813.  
  3814.   { Not found from the dictionary. Finds from the system locale table }
  3815.  
  3816. {$IFDEF WIN32}
  3817.   Result := GetSystemLocaleData(id, locale);
  3818. {$ELSE}
  3819.   Result := False;
  3820. {$ENDIF}
  3821. end;
  3822.  
  3823. procedure TIvDictionary.GetPrimaryLanguages(primaries: TStrings; native: Boolean);
  3824. var
  3825.   found: Boolean;
  3826.   i, j: Integer;
  3827.   languages: TList;
  3828.   language: TIvLanguage;
  3829. begin
  3830.   languages := TList.Create;
  3831.   GetLanguageDatas(languages);
  3832.  
  3833.   for i := 0 to LanguageCount - 1 do
  3834.   begin
  3835.     language := TIvLanguage(languages[i]);
  3836.  
  3837.     found := False;
  3838.     for j := 0 to i - 1 do
  3839.     begin
  3840.       if language.Primary = TIvLanguage(languages[j]).Primary then
  3841.       begin
  3842.         found := True;
  3843.         Break;
  3844.       end;
  3845.     end;
  3846.  
  3847.     if not found then
  3848.     begin
  3849.       if native then
  3850.         primaries.AddObject(language.NativeName, TObject(language.Primary))
  3851.       else
  3852.         primaries.AddObject(language.EnglishName, TObject(language.Primary));
  3853.     end;
  3854.   end;
  3855.  
  3856.   FreeList(languages);
  3857. end;
  3858.  
  3859. {$IFDEF WIN32}
  3860. class procedure TIvDictionary.GetSystemLocales(locales: TList);
  3861.  
  3862.   function EnumLocales(localeStr: PChar): Integer; stdcall;
  3863.   var
  3864.     id: Integer;
  3865.     locale: TIvLocale;
  3866.   begin
  3867.     id := StrToInt('$' + localeStr);
  3868.     locale := TIvLocale.Create;
  3869.     TIvDictionary.GetSystemLocaleData(id, locale);
  3870.     enumList.Add(locale);
  3871.     Result := 1;
  3872.   end;
  3873.  
  3874. begin
  3875.   { Gets the system locales }
  3876.  
  3877.   enumList := locales;
  3878.   EnumSystemLocales(@EnumLocales, LCID_SUPPORTED);
  3879. end;
  3880.  
  3881. class procedure TIvDictionary.GetSystemLocaleIds(locales: TList);
  3882.  
  3883.   function EnumLocales(localeStr: PChar): Integer; stdcall;
  3884.   var
  3885.     id: Integer;
  3886.   begin
  3887.     id := StrToInt('$' + localeStr);
  3888.     enumList.Add(Pointer(id));
  3889.     Result := 1;
  3890.   end;
  3891.  
  3892. begin
  3893.   { Gets the system locales }
  3894.  
  3895.   enumList := locales;
  3896.   EnumSystemLocales(@EnumLocales, LCID_SUPPORTED);
  3897. end;
  3898. {$ENDIF}
  3899.  
  3900. procedure TIvDictionary.GetLocales(locales: TList);
  3901. var
  3902.   i, j: Integer;
  3903.   found: Boolean;
  3904.   locale: TIvLocale;
  3905. begin
  3906. {$IFDEF WIN32}
  3907.   GetSystemLocales(locales);
  3908. {$ENDIF}
  3909.  
  3910.   { Gets the custom locales }
  3911.  
  3912.   for i := 0 to LocaleCount - 1 do
  3913.   begin
  3914.     locale := TIvLocale.Create;
  3915.     GetLocaleData(i, locale);
  3916.  
  3917.     { Checks if the locale already exists in the list }
  3918.  
  3919.     found := False;
  3920.     for j := 0 to locales.Count - 1 do
  3921.     begin
  3922.       if TIvLocale(locales[j]).Locale = locale.Locale then
  3923.       begin
  3924.         found := True;
  3925.         TIvLocale(locales[j]).Assign(locale);
  3926.         Break;
  3927.       end;
  3928.     end;
  3929.  
  3930.     { If not found, adds the locale to the list }
  3931.  
  3932.     if found then
  3933.       locale.Free
  3934.     else
  3935.       locales.Add(locale);
  3936.   end;
  3937. end;
  3938.  
  3939. procedure TIvDictionary.GetLocaleIds(locales: TList);
  3940. var
  3941.   i, j: Integer;
  3942.   found: Boolean;
  3943.   locale: TIvLocale;
  3944. begin
  3945. {$IFDEF WIN32}
  3946.   GetSystemLocaleIds(locales);
  3947. {$ENDIF}
  3948.  
  3949.   { Gets the custom locales }
  3950.  
  3951.   for i := 0 to LocaleCount - 1 do
  3952.   begin
  3953.     locale := TIvLocale.Create;
  3954.     GetLocaleData(i, locale);
  3955.  
  3956.     { Checks if the locale already exists in the list }
  3957.  
  3958.     found := False;
  3959.     for j := 0 to locales.Count - 1 do
  3960.     begin
  3961.       if Integer(locales[j]) = locale.Locale then
  3962.       begin
  3963.         found := True;
  3964.         Break;
  3965.       end;
  3966.     end;
  3967.  
  3968.     { If not found, adds the locale to the list }
  3969.  
  3970.     if not found then
  3971.       locales.Add(Pointer(locale.Locale));
  3972.     locale.Free
  3973.   end;
  3974. end;
  3975.  
  3976. class procedure TIvDictionary.FreeList(list: TList);
  3977. var
  3978.   i: Integer;
  3979. begin
  3980.   for i := 0 to list.Count - 1 do
  3981.     TObject(list[i]).Free;
  3982.   list.Free;
  3983. end;
  3984.  
  3985.  
  3986. {$IFNDEF WIN32}
  3987. function TIvDictionary.GetSystemDefaultLCID: Integer;
  3988. begin
  3989.   Result := GetUserDefaultLCID;
  3990. end;
  3991.  
  3992. function TIvDictionary.GetUserDefaultLCID: Integer;
  3993. const
  3994.   INTL_C = 'intl';
  3995. var
  3996.   i: Integer;
  3997.   language, country: String;
  3998.   locales: TList;
  3999.   locale: TIvLocale;
  4000. begin
  4001.   { If the user's default locale has already been determined, returns it }
  4002.  
  4003.   if userDefaultLCID <> 0 then
  4004.   begin
  4005.     Result := userDefaultLCID;
  4006.     Exit;
  4007.   end;
  4008.  
  4009.   { Win16 specifies the locale using the language code and country string.
  4010.     They are stored in WIN.INI }
  4011.  
  4012.   country := GetProfileStr(INTL_C, 'sCountry', '');
  4013.   language := GetProfileStr(INTL_C, 'sLanguage', '');
  4014.  
  4015.   locales := TList.Create;
  4016.   try
  4017.     GetLocaleDatas(locales);
  4018.  
  4019.     { Scans the locales to find the matching language code. }
  4020.  
  4021.     for i := 0 to locales.Count - 1 do
  4022.     begin
  4023.       locale := TIvLocale(locales[i]);
  4024.  
  4025.       if CompareText(language, locale.Win16LanguageName) = 0 then
  4026.       begin
  4027.         userDefaultLCID := locale.Locale;
  4028.         Result := userDefaultLCID;
  4029.         Exit;
  4030.       end;
  4031.     end;
  4032.  
  4033.     { No match found. Gets the first code where the first two characters and
  4034.       country match. }
  4035.  
  4036.     language := Copy(language, 1, 2);
  4037.     for i := 0 to locales.Count - 1 do
  4038.     begin
  4039.       locale := TIvLocale(locales[i]);
  4040.  
  4041.       if (CompareText(language, Copy(locale.Win16LanguageName, 1, 2)) = 0) and
  4042.         (CompareText(country, locale.Win16CountryName) = 0) then
  4043.       begin
  4044.         userDefaultLCID := locale.Locale;
  4045.         Result := userDefaultLCID;
  4046.         Exit;
  4047.       end;
  4048.     end;
  4049.  
  4050.     { No match found. Gets the first code where the first two characters match. }
  4051.  
  4052.     language := Copy(language, 1, 2);
  4053.     for i := 0 to locales.Count - 1 do
  4054.     begin
  4055.       locale := TIvLocale(locales[i]);
  4056.  
  4057.       if CompareText(language, Copy(locale.Win16LanguageName, 1, 2)) = 0 then
  4058.       begin
  4059.         userDefaultLCID := locale.Locale;
  4060.         Result := userDefaultLCID;
  4061.         Exit;
  4062.       end;
  4063.     end;
  4064.  
  4065.     { No match found. The default language of the dictionary is used. }
  4066.  
  4067.     userDefaultLCID := IvMakeLcId(
  4068.       IvMakeLangid(Languages[DefaultLanguage].Primary, SUBLANG_DEFAULT),
  4069.       SORT_DEFAULT);
  4070.     Result := userDefaultLCID;
  4071.   finally
  4072.     FreeList(locales);
  4073.   end;
  4074. end;
  4075. {$ENDIF}
  4076.  
  4077. procedure TIvDictionary.GetSubLanguages(
  4078.   language: TIvLanguage;
  4079.   subs: TStrings;
  4080.   native: Boolean);
  4081. var
  4082.   i, j, sub: Integer;
  4083.   locales: TList;
  4084.   locale: TIvLocale;
  4085.  
  4086.   procedure Add(locale: TIvLocale);
  4087.   var
  4088.     i: Integer;
  4089.   begin
  4090.     for i := 0 to subs.Count - 1 do
  4091.     begin
  4092.       if Integer(subs.Objects[i]) = locale.Locale then
  4093.         Exit;
  4094.     end;
  4095.  
  4096.     if native then
  4097.       subs.AddObject(locale.NativeCountryName, TObject(locale.Locale))
  4098.     else
  4099.       subs.AddObject(locale.EnglishCountryName, TObject(locale.Locale));
  4100.   end;
  4101.  
  4102. begin
  4103.   locales := TList.Create;
  4104.   GetLocales(locales);
  4105.  
  4106.   if language.SubCount = 0 then
  4107.   begin
  4108.     for i := 0 to locales.Count - 1 do
  4109.     begin
  4110.       locale := TIvLocale(locales[i]);
  4111.       if language.Primary = locale.Primary then
  4112.         Add(locale);
  4113.     end;
  4114.   end
  4115.   else
  4116.   begin
  4117.     for i := 0 to language.SubCount - 1 do
  4118.     begin
  4119.       sub := language.Subs[i];
  4120.       for j := 0 to locales.Count - 1 do
  4121.       begin
  4122.         locale := TIvLocale(locales[j]);
  4123.         if (locale.Primary = language.Primary) and (locale.Sub = sub) then
  4124.           Add(locale);
  4125.       end;
  4126.     end;
  4127.   end;
  4128.  
  4129.   FreeList(locales);
  4130. end;
  4131.  
  4132. procedure TIvDictionary.TranslateWindow(wnd: THandle; str: String; resize: Boolean);
  4133. var
  4134.   dc: HDC;
  4135.   width, style: Integer;
  4136.   rect, calcRect: TRect;
  4137.   buffer: array[0..255] of Char;
  4138. begin
  4139.   { Changes the text of the window. If resizing was allowed resized the window. }
  4140.  
  4141.   if str = '' then
  4142.   begin
  4143.     GetWindowText(wnd, buffer, Sizeof(buffer));
  4144. {$IFDEF WIN32}
  4145.     str := buffer;
  4146. {$ELSE}
  4147.     str := StrPas(buffer);
  4148. {$ENDIF}
  4149.   end;
  4150.   str := Translate(str);
  4151. {$IFDEF WIN32}
  4152.   SetWindowText(wnd, PChar(str));
  4153. {$ELSE}
  4154.   SetWindowText(wnd, StrPCopy(buffer, str));
  4155. {$ENDIF}
  4156.  
  4157.   { Resized the window }
  4158.  
  4159.   if resize then
  4160.   begin
  4161.     { Calculates the width of the text. If the current width of the windows is
  4162.       less then resizez the window. }
  4163.  
  4164.     dc := GetWindowDC(wnd);
  4165. {$IFDEF WIN32}
  4166.     SelectObject(dc, GetStockObject(DEFAULT_GUI_FONT));
  4167.     width := DrawText(dc, PChar(str), -1, calcRect, DT_LEFT or DT_CALCRECT or DT_SINGLELINE);
  4168. {$ELSE}
  4169.     SelectObject(dc, GetStockObject(SYSTEM_FONT));
  4170.     width := DrawText(dc, StrPCopy(buffer, str), -1, calcRect, DT_LEFT or DT_CALCRECT or DT_SINGLELINE);
  4171. {$ENDIF}
  4172.     ReleaseDC(wnd, dc);
  4173.     if width <= 0 then
  4174.       Exit;
  4175.  
  4176.     width := calcRect.right - calcRect.left;
  4177.     GetClassName(wnd, buffer, SizeOf(buffer));
  4178.     StrLower(buffer);
  4179. {$IFDEF WIN32}
  4180.     if buffer = 'button' then
  4181. {$ELSE}
  4182.     if StrComp(buffer, 'button') = 0 then
  4183. {$ENDIF}
  4184.     begin
  4185.       { Check box and radion buttons need some space for the input area. }
  4186.  
  4187.       style := GetWindowLong(wnd, GWL_STYLE);
  4188.       if ((style and BS_CHECKBOX) <> 0) or ((style and BS_RADIOBUTTON) <> 0) then
  4189.         width := width + 20;
  4190.     end;
  4191.  
  4192.     { If the current width is less the the needed width resizes the windows }
  4193.  
  4194.     GetWindowRect(wnd, rect);
  4195.     if (rect.right - rect.left) < width then
  4196.       SetWindowPos(wnd, 0, 0, 0, width, rect.bottom - rect.top, SWP_NOMOVE or SWP_NOZORDER);
  4197.   end;
  4198. end;
  4199.  
  4200. function TIvDictionary.IsDesignTime: Boolean;
  4201. begin
  4202. {$IFDEF IVVB}
  4203.   Result := GenericIsDesignTime(Self);
  4204. {$ELSE}
  4205.   Result := csDesigning in ComponentState;
  4206. {$ENDIF}
  4207. end;
  4208.  
  4209. { TIvDictionaries }
  4210.  
  4211. constructor TIvDictionaries.Create;
  4212. begin
  4213.   inherited Create;
  4214.   FItems := TList.Create;
  4215. end;
  4216.  
  4217. destructor TIvDictionaries.Destroy;
  4218. begin
  4219.   FItems.Free;
  4220.   inherited Destroy;
  4221. end;
  4222.  
  4223. function TIvDictionaries.GetCount: Integer;
  4224. begin
  4225.   Result := FItems.Count;
  4226. end;
  4227.  
  4228. function TIvDictionaries.GetItems(index: Integer): TIvDictionary;
  4229. begin
  4230.   Result := FItems[index];
  4231. end;
  4232.  
  4233. function TIvDictionaries.FindDictionary(const name: String): TIvDictionary;
  4234. var
  4235.   i: Integer;
  4236. begin
  4237.   for i := 0 to Count - 1 do
  4238.   begin
  4239.     Result := Items[i];
  4240.  
  4241.     if Result.DictionaryName = name then
  4242.       Exit;
  4243.   end;
  4244.  
  4245.   Result := nil;
  4246. end;
  4247.  
  4248. procedure TIvDictionaries.Add(item: TIvDictionary);
  4249. var
  4250.   i: Integer;
  4251.   name: String;
  4252. begin
  4253.   if item.DictionaryName = '' then
  4254.   begin
  4255.     i := Dictionaries.Count;
  4256.     repeat
  4257.       Inc(i);
  4258.       name := 'Dictionary' + IntToStr(i);
  4259.       item.DictionaryName := name;
  4260.     until FindDictionary(name) = nil;
  4261.   end;  
  4262.  
  4263.   FItems.Add(item);
  4264. end;
  4265.  
  4266. procedure TIvDictionaries.Remove(item: TIvDictionary);
  4267. begin
  4268.   FItems.Remove(item);
  4269. end;
  4270.  
  4271.  
  4272. { TIvCustomTranslator }
  4273.  
  4274. constructor TIvCustomTranslator.Create(owner: TComponent);
  4275. begin
  4276.   inherited Create(owner);
  4277.   FState := [];
  4278.   FTranslations := TList.Create;
  4279.   if IsDesignTime and (Dictionaries.Count > 0) then
  4280.     Dictionary := Dictionaries[0];
  4281. end;
  4282.  
  4283. destructor TIvCustomTranslator.Destroy;
  4284. begin
  4285.   ClearTranslations;
  4286.   FTranslations.Free;
  4287.   inherited Destroy;
  4288. end;
  4289.  
  4290. procedure TIvCustomTranslator.ClearTranslations;
  4291. var
  4292.   i: Integer;
  4293. begin
  4294.   for i := 0 to FTranslations.Count - 1 do
  4295.     TIvTranslation(FTranslations[i]).Free;
  4296.   FTranslations.Clear;
  4297. end;
  4298.  
  4299. procedure TIvCustomTranslator.SetDictionary(value: TIvDictionary);
  4300. begin
  4301.   if value <> FDictionary then
  4302.   begin
  4303.     if not IsDesignTime and (ivtsBound in FState) then
  4304.       UnbindAndSetNative;
  4305.     FDictionary := value;
  4306.     if FDictionary <> nil then
  4307.       FDictionaryName := FDictionary.DictionaryName;
  4308.   end;
  4309.  
  4310. {$IFDEF WIN32}
  4311.   if value <> nil then
  4312.     value.FreeNotification(Self);
  4313. {$ENDIF}
  4314. end;
  4315.  
  4316. procedure TIvCustomTranslator.SetDictionaryName(const value: String);
  4317. begin
  4318.   if FDictionaryName <> value then
  4319.   begin
  4320.     Dictionary := Dictionaries.FindDictionary(value);
  4321.     FDictionaryName := value;
  4322.   end;
  4323. end;
  4324.  
  4325. procedure TIvCustomTranslator.LanguageChanged(languageChanged, localeChanged: Boolean);
  4326. begin
  4327. end;
  4328.  
  4329. {$IFDEF WIN32}
  4330. procedure TIvCustomTranslator.TranslateSystemMenu(handle: THandle; mdi: Boolean);
  4331. var
  4332.   i, j, count: Integer;
  4333.   str, current: String;
  4334.   menu: THandle;
  4335.   info: TMenuItemInfo;
  4336.   buffer: array[0..255] of Char;
  4337.  
  4338.   function Translate(const str: String): String;
  4339.   var
  4340.     l, h, i, c: Integer;
  4341.     translation: TIvTranslation;
  4342.   begin
  4343.     { Tries to first find from the translation list }
  4344.  
  4345.     l := 0;
  4346.     h := FTranslations.Count - 1;
  4347.     while l <= h do
  4348.     begin
  4349.       i := (l + h) div 2;
  4350.       translation := TIvTranslation(FTranslations[i]);
  4351.       c := TIvDictionary.IvCompareStr(translation.Key, str, Dictionary.NativeLocale, False);
  4352.       if c = 0 then
  4353.       begin
  4354.         Result := translation.Current;
  4355.         if Result = '' then
  4356.           Result := str;
  4357.         Exit;
  4358.       end
  4359.       else if c < 0 then
  4360.         l := i + 1
  4361.       else
  4362.         h := i - 1;
  4363.     end;
  4364.  
  4365.     { Not found. Gets the translation from the dictionary. }
  4366.  
  4367.     Result := FDictionary.Translate(str);
  4368.   end;
  4369.  
  4370. begin
  4371.   if (FDictionary = nil) or (handle = 0) then
  4372.     Exit;
  4373.  
  4374. {$IFDEF IVBIDI}
  4375.   info.cbSize := 44;
  4376. {$ELSE}
  4377.   info.cbSize := Sizeof(info);
  4378. {$ENDIF}
  4379.   info.fMask := MIIM_TYPE or MIIM_ID;
  4380.  
  4381.   menu := GetSystemMenu(handle, False);
  4382.   count := GetMenuItemCount(menu);
  4383.   for i := 0 to count - 1 do
  4384.   begin
  4385.     { Get the menu type }
  4386.  
  4387.     info.dwTypeData := buffer;
  4388.     info.cch := Sizeof(buffer);
  4389.     if not GetMenuItemInfo(menu, i, True, info) then
  4390.       Continue;
  4391.  
  4392.     if (info.fType and MFT_SEPARATOR) = 0 then
  4393.     begin
  4394.       case info.wID of
  4395.         SC_CLOSE: str := '&Close';
  4396.         SC_RESTORE: str := '&Restore';
  4397.         SC_MOVE: str := '&Move';
  4398.         SC_SIZE: str := '&Size';
  4399.         SC_MINIMIZE: str := 'Mi&nimize';
  4400.         SC_MAXIMIZE: str := 'Ma&ximize';
  4401.         SC_NEXTWINDOW: str := '&Next';
  4402.  
  4403.         { To do! Check the following strings }
  4404.  
  4405.         SC_PREVWINDOW: str := '&Previous';
  4406.         SC_VSCROLL: str := '&Vertical Scroll';
  4407.         SC_HSCROLL: str := '&Horizontal Scroll';
  4408.         SC_MOUSEMENU: str := '&Mouse';
  4409.         SC_KEYMENU: str := '&Key';
  4410.         SC_ARRANGE: str := '&Arrange';
  4411.         SC_TASKLIST: str := '&Task List';
  4412.         SC_SCREENSAVE: str := '&Screen Saver';
  4413.         SC_HOTKEY: str := '&Hot Key';
  4414.         SC_DEFAULT: str := '&Default';
  4415.         SC_MONITORPOWER: str := '&Monitor Power';
  4416.       end;
  4417.  
  4418.       if ivtsPreScanning in FState then
  4419.         FTranslations.Add(TIvTranslation.CreateValue(str, '', ''))
  4420.       else
  4421.       begin
  4422.         str := Translate(str);
  4423.  
  4424.         { Get the current menu text }
  4425.  
  4426.         if GetMenuString(menu, i, buffer, Sizeof(buffer), MF_BYPOSITION) <> 0 then
  4427.         begin
  4428.           current := buffer;
  4429.           j := Pos(#9, current);
  4430.           if j > 0 then
  4431.           begin
  4432.             Delete(current, 1, j);
  4433.             str := str + #9 + current;
  4434.           end;
  4435.         end;
  4436.  
  4437.         { Sets the new text value to the menu }
  4438.  
  4439.         StrPCopy(buffer, str);
  4440.         info.fType := MFT_STRING;
  4441.         info.dwTypeData := buffer;
  4442.         SetMenuItemInfo(menu, i, True, info);
  4443.       end;
  4444.     end;
  4445.   end;
  4446. end;
  4447.  
  4448. { Return Window handle to a window containing the system menu.
  4449.   By default there are no window with a system menu. However,
  4450.   TIvTranslator overrides this to return a window handle to the
  4451.   Host-component and TIvTranslatorEx to the VB-form. }
  4452.  
  4453. function TIvCustomTranslator.GetSystemMenuWinHandle: THandle;
  4454. begin
  4455.   Result := 0;
  4456. end;
  4457. {$ENDIF}
  4458.  
  4459. procedure TIvCustomTranslator.TranslateHost;
  4460. begin
  4461. end;
  4462.  
  4463. procedure TIvCustomTranslator.Translate;
  4464. begin
  4465.   FState := FState + [ivtsBound];
  4466. end;
  4467.  
  4468. procedure TIvCustomTranslator.Unbind;
  4469. begin
  4470.   if (ivtsBound in FState) and (FDictionary <> nil) then
  4471.     FDictionary.RemoveTranslator(Self);
  4472.   FDictionary := nil;
  4473.   FState := [];
  4474. end;
  4475.  
  4476. procedure TIvCustomTranslator.UnbindAndSetNative;
  4477. begin
  4478.   Unbind;
  4479. end;
  4480.  
  4481. function TIvCustomTranslator.IsDesignTime: boolean;
  4482. begin
  4483. {$IFDEF IVVB}
  4484.   Result := GenericIsDesignTime(Self);
  4485. {$ELSE}
  4486.   Result := csDesigning in ComponentState;
  4487. {$ENDIF}
  4488. end;
  4489.  
  4490. { Locale functions }
  4491.  
  4492. function IvDoesLanguageRequirePro(primary: Integer): Boolean;
  4493. begin
  4494.   case primary of
  4495.     LANG_ARABIC,
  4496.     LANG_HEBREW,
  4497.     LANG_FARSI,
  4498.  
  4499.     LANG_CHINESE,
  4500.     LANG_JAPANESE,
  4501.     LANG_KOREAN,
  4502.  
  4503.     LANG_THAI,
  4504.     LANG_VIETNAMESE:
  4505.       Result := True
  4506.   else
  4507.     Result := False;
  4508.   end;
  4509. end;
  4510.  
  4511. function IvDoesLanguageRequirePro32(primary: Integer): Boolean;
  4512. begin
  4513.   case primary of
  4514.     LANG_ARABIC,
  4515.     LANG_HEBREW,
  4516.     LANG_FARSI:
  4517.       Result := True
  4518.   else
  4519.     Result := False;
  4520.   end;
  4521. end;
  4522.  
  4523. function IvMakeLangId(primaryLanguage, subLanguage: Integer): Integer;
  4524. begin
  4525.   Result := (subLanguage shl 10) or primaryLanguage;
  4526. end;
  4527.  
  4528. function IvMakeLcId(langId, sortId: Integer): Integer;
  4529. begin
  4530.   Result := (sortId shl 16) or langId;
  4531. end;
  4532.  
  4533. function IvGetPrimaryFromLocale(locale: Integer): Integer;
  4534. begin
  4535.   Result := locale and $3FF;
  4536. end;
  4537.  
  4538. function IvGetSubFromLocale(locale: Integer): Integer;
  4539. begin
  4540.   Result := (locale shr 10) and $3F;
  4541. end;
  4542.  
  4543. function IsEMUMember(locale: Integer): Boolean;
  4544. var
  4545.   sub: Integer;
  4546. begin
  4547.   { Emu countries:
  4548.     Austria (German)
  4549.     Belgium (Dutch, French)
  4550.     Finland (Finnish, Swedish)
  4551.     France (French)
  4552.     Germany (German)
  4553.     Irland (English)
  4554.     Italy (Italian)
  4555.     Luxembourg (German, French)
  4556.     Netherlands (Dutch)
  4557.     Portugal (Portuguese)
  4558.     Spain (Spanish) }
  4559.  
  4560.   sub := IvGetSubFromLocale(locale);
  4561.   Result := False;
  4562.   case IvGetPrimaryFromLocale(locale) of
  4563.     LANG_DUTCH:
  4564.       Result := (sub = SUBLANG_DUTCH) or (sub = SUBLANG_DUTCH_BELGIAN);
  4565.  
  4566.     LANG_ENGLISH:
  4567.       Result := sub = SUBLANG_ENGLISH_EIRE;
  4568.  
  4569.     LANG_FINNISH:
  4570.       Result := sub = SUBLANG_DEFAULT;
  4571.  
  4572.     LANG_FRENCH:
  4573.       Result := (sub = SUBLANG_FRENCH) or (sub = SUBLANG_FRENCH_BELGIAN) or (sub = SUBLANG_FRENCH_LUXEMBOURG);
  4574.  
  4575.     LANG_GERMAN:
  4576.       Result := (sub = SUBLANG_GERMAN) or (sub = SUBLANG_GERMAN_AUSTRIAN) or (sub = SUBLANG_GERMAN_LUXEMBOURG);
  4577.  
  4578.     LANG_ITALIAN:
  4579.       Result := sub = SUBLANG_ITALIAN;
  4580.  
  4581.     LANG_PORTUGUESE:
  4582.       Result := sub = SUBLANG_PORTUGUESE;
  4583.  
  4584.     LANG_SWEDISH:
  4585.       Result := sub = SUBLANG_SWEDISH_FINLAND;
  4586.  
  4587.     LANG_SPANISH:
  4588.       Result := sub = SUBLANG_SPANISH;
  4589.   end;
  4590. end;
  4591.  
  4592. function GetEMUPhase: TIvEMU;
  4593. var
  4594.   d: TDateTime;
  4595. begin
  4596.   { Before January 1 1999 only the local currency is used
  4597.     From January 1 1999 to January 1 2002 Euro is also used as a account currency
  4598.     From January 1 2002 to July 1 2002 both Euro and locale currencies are used
  4599.     From July 1 2002 only Euro is used
  4600.  
  4601.     Note! July 1 might be moved to an earlied date. }
  4602.  
  4603.   d := Date;
  4604.   if d < EncodeDate(1999, 1, 1) then
  4605.     Result := iveLocal
  4606.   else if d < EncodeDate(2002, 1, 1) then
  4607.     Result := iveLocalAndEuro
  4608.   else if d < EncodeDate(2002, 7, 1) then
  4609.     Result := iveEuroAndLocal
  4610.   else
  4611.     Result := iveEuro;
  4612. end;
  4613.  
  4614. {$IFDEF WIN32}
  4615. function IvGetCharSetInfo(langId: Integer): TIvCharsetInfo;
  4616. var
  4617.   i: Integer;
  4618.   flag: DWORD;
  4619.   lfs: TLocaleFontSignature;
  4620. begin
  4621.   if GetLocaleInfo(IvMakeLcId(langId, 0), LOCALE_FONTSIGNATURE, PChar(@lfs), Sizeof(lfs)) <> 0 then
  4622.   begin
  4623.     flag := 1;
  4624.     for i := 0 to CHARSET_COUNT_C - 1 do
  4625.     begin
  4626.       if (flag and lfs.fsCsbDefault[0]) <> 0 then
  4627.       begin
  4628.         Result := CHARSETSET_TO_ID_C[i];
  4629.         Exit;
  4630.       end;
  4631.       flag := flag shl 1;
  4632.     end;
  4633.   end;
  4634.   Result := CHARSETSET_TO_ID_C[0];
  4635. end;
  4636.  
  4637. function IvLangIdToCharSet(langId: Integer): TFontCharset;
  4638. begin
  4639.   Result := IvGetCharSetInfo(langId).charSet;
  4640. end;
  4641.  
  4642. function IvCodePageToCharSet(codePage: Integer): TFontCharset;
  4643. var
  4644.   i: Integer;
  4645. begin
  4646.   Result := DEFAULT_CHARSET;
  4647.   for i := 0 to CHARSET_COUNT_C - 1 do
  4648.   begin
  4649.     if CHARSETSET_TO_ID_C[i].codePage = codePage then
  4650.     begin
  4651.       Result := CHARSETSET_TO_ID_C[i].charSet;
  4652.       Exit;
  4653.     end;
  4654.   end;
  4655. end;
  4656.  
  4657.  
  4658. const
  4659.   CHARSET_CODES_C: array[TIvFontCharset] of TFontCharset =
  4660.   (
  4661.     DEFAULT_CHARSET,
  4662.     OEM_CHARSET,
  4663.     SYMBOL_CHARSET,
  4664.     MAC_CHARSET,
  4665.     ANSI_CHARSET,
  4666.     EASTEUROPE_CHARSET,
  4667.     BALTIC_CHARSET,
  4668.     RUSSIAN_CHARSET,
  4669.     GREEK_CHARSET,
  4670.     TURKISH_CHARSET,
  4671.     ARABIC_CHARSET,
  4672.     HEBREW_CHARSET,
  4673.     SHIFTJIS_CHARSET,
  4674.     HANGEUL_CHARSET,
  4675.     JOHAB_CHARSET,
  4676.     CHINESEBIG5_CHARSET,
  4677.     GB2312_CHARSET,
  4678.     THAI_CHARSET,
  4679.     VIETNAMESE_CHARSET
  4680.   );
  4681.  
  4682. function IvCharsetToCode(value: TIvFontCharset): Byte;
  4683. begin
  4684.   Result := CHARSET_CODES_C[value];
  4685. end;
  4686.  
  4687. function IvCodeToCharset(value: Byte): TIvFontCharset;
  4688. begin
  4689.   for Result := Low(TIvFontCharSet) to High(TIvFontCharSet) do
  4690.     if CHARSET_CODES_C[Result] = value then
  4691.       Exit;
  4692.   raise Exception.Create('Invalid charset code');
  4693. end;
  4694.  
  4695. procedure InitLogFont(var logFont: TLogFont; const name: String; cs: TFontCharset);
  4696. begin
  4697.   StrPCopy(logFont.lfFaceName, name);
  4698.   logFont.lfCharSet := cs;
  4699.   case logFont.lfCharSet of
  4700.     HEBREW_CHARSET, ARABIC_CHARSET: logFont.lfPitchAndFamily := 0;
  4701.   else
  4702.     logFont.lfPitchAndFamily := MONO_FONT;
  4703.   end;
  4704. end;
  4705.  
  4706. function IvGetSupportedCharsets: TIvFontCharsets;
  4707. var
  4708.   cs: TIvFontCharSet;
  4709.   supported: Boolean;
  4710.   logFont: TLogFont;
  4711.   dc: HDC;
  4712.  
  4713.   function EnumFontFamilies(
  4714.     logFont: PEnumLogFontEx;
  4715.     textMetrics: PNewTextMetricEx;
  4716.     fontType: Integer;
  4717.     var supported: Boolean): Integer; stdcall;
  4718.   begin
  4719.     supported := True;
  4720.     Result := 0;
  4721.   end;
  4722.  
  4723. begin
  4724.   dc := GetDC(0);
  4725.   Result := [];
  4726.   for cs := Low(TIvFontCharSet) to High(TIvFontCharSet) do
  4727.   begin
  4728.     InitLogFont(logFont, '', IvCharsetToCode(cs));
  4729.     supported := False;
  4730.     EnumFontFamiliesEx(dc, logFont, @EnumFontFamilies, Integer(@supported), 0);
  4731.     if supported then
  4732.       Result := Result + [cs];
  4733.   end;
  4734.   ReleaseDC(0, dc);
  4735. end;
  4736.  
  4737. function EnumFontNames(
  4738.   logFont: PEnumLogFontEx;
  4739.   textMetrics: PNewTextMetricEx;
  4740.   fontType: Integer;
  4741.   names: TStrings): Integer; stdcall;
  4742. var
  4743.   count: Integer;
  4744.   name: String;
  4745. begin
  4746.   Result := 1;
  4747.   count := names.Count;
  4748.   name := logFont.elfLogFont.lfFaceName;
  4749.   if (count = 0) or (names[count - 1] <> name) and (name[1] <> '@') then
  4750.     names.Add(name);
  4751. end;
  4752.  
  4753. procedure IvGetFontNames(charsets: TIvFontCharsets; names: TStrings);
  4754. var
  4755.   i, j: Integer;
  4756.   cs: TIvFontCharSet;
  4757.   logFont: TLogFont;
  4758.   newNames, tempNames: TStringList;
  4759.   dc: HDC;
  4760. begin
  4761.   dc := GetDC(0);
  4762.  
  4763.   { Gets all the font names }
  4764.  
  4765.   InitLogFont(logFont, '', DEFAULT_CHARSET);
  4766.   names.Clear;
  4767.   EnumFontFamiliesEx(dc, logFont, @EnumFontNames, Integer(names), 0);
  4768.  
  4769.   for cs := Low(TIvFontCharSet) to High(TIvFontCharSet) do
  4770.   begin
  4771.     if not (cs in charsets) then
  4772.       Continue;
  4773.  
  4774.     { Gets support for each charsets }
  4775.  
  4776.     tempNames := TStringList.Create;
  4777.     InitLogFont(logFont, '', IvCharsetToCode(cs));
  4778.     EnumFontFamiliesEx(dc, logFont, @EnumFontNames, Integer(tempNames), 0);
  4779.  
  4780.     { Names and logical AND of names and tempNames }
  4781.  
  4782.     newNames := TStringList.Create;
  4783.     for i := 0 to names.Count - 1 do
  4784.     begin
  4785.       for j := 0 to tempNames.Count - 1 do
  4786.       begin
  4787.         if names[i] = tempNames[j] then
  4788.         begin
  4789.           newNames.Add(names[i]);
  4790.           Break;
  4791.         end;
  4792.       end;
  4793.     end;
  4794.     tempNames.Free;
  4795.  
  4796.     { Updates the font name list }
  4797.  
  4798.     names.Assign(newNames);
  4799.     newNames.Free;
  4800.   end;
  4801.   ReleaseDC(0, dc);
  4802. end;
  4803.  
  4804. procedure IvGetFontNamesOfCharset(charset: Integer; names: TStrings);
  4805. var
  4806.   dc: HDC;
  4807.   logFont: TLogFont;
  4808. begin
  4809.   dc := GetDC(0);
  4810.   try
  4811.     InitLogFont(logFont, '', charset);
  4812.     EnumFontFamiliesEx(dc, logFont, @EnumFontNames, Integer(names), 0);
  4813.   finally
  4814.     ReleaseDC(0, dc);
  4815.   end;
  4816. end;
  4817. {$ENDIF}
  4818.  
  4819. function IvGetCharacterSetType(locale: Integer): TIvCharacterSetType;
  4820. begin
  4821.   case IvGetPrimaryFromLocale(locale) of
  4822.     LANG_CHINESE, LANG_JAPANESE, LANG_KOREAN: Result := ivcsMultiByte;
  4823.     LANG_ARABIC, LANG_HEBREW, LANG_FARSI: Result := ivcsBiDirectional;
  4824.   else
  4825.     Result := ivcsSingleByte;
  4826.   end;
  4827. end;
  4828.  
  4829. function IvIsLocaleSingleByte(locale: Integer): Boolean;
  4830. begin
  4831.   Result := IvGetCharacterSetType(locale) = ivcsSingleByte;
  4832. end;
  4833.  
  4834. function IvIsLocaleMultiByte(locale: Integer): Boolean;
  4835. begin
  4836.   Result := IvGetCharacterSetType(locale) = ivcsMultiByte;
  4837. end;
  4838.  
  4839. function IvIsLocaleBidirectional(locale: Integer): Boolean;
  4840. begin
  4841.   Result := IvGetCharacterSetType(locale) = ivcsBiDirectional;
  4842. end;
  4843.  
  4844. {$IFDEF WIN32}
  4845. function IvWStrToStr(const source: TIvWideString; codePage: Integer): String;
  4846. var
  4847.   len: Integer;
  4848. begin
  4849.   // Calculates the size of the ansi string, sets the string length and
  4850.   // converts the string
  4851.  
  4852. {$IFDEF IVWIDE}
  4853.   if source = '' then
  4854. {$ELSE}
  4855.   if source^ = Chr(0) then
  4856. {$ENDIF}
  4857.     Result := ''
  4858.   else
  4859.   begin
  4860.     len := WideCharToMultiByte(codePage, 0, PWideChar(source), -1, nil, 0, nil, nil);
  4861.     SetLength(Result, len - 1);
  4862.     WideCharToMultiByte(codePage, 0, PWideChar(source), -1, PChar(Result), len, nil, nil);
  4863.   end;
  4864. end;
  4865.  
  4866. function IvStrToWStr(const source: String; codePage: Integer): TIvWideString;
  4867. var
  4868.   len: Integer;
  4869. begin
  4870.   if source = '' then
  4871.     Result := ''
  4872.   else
  4873.   begin
  4874.     // Calculates the size of the string
  4875.  
  4876.     len := MultiByteToWideChar(codePage, 0, PChar(source), -1, nil, 0);
  4877.  
  4878. {$IFDEF IVWIDE}
  4879.     // Sets the string length and converts the string
  4880.  
  4881.     SetLength(Result, len - 1);
  4882.     MultiByteToWideChar(codePage, 0, PChar(source), -1, PWideChar(Result), len);
  4883. {$ELSE}
  4884.     // Frees the current commaon string, allocates the new one and
  4885.     // converts the string
  4886.  
  4887.     SysFreeString(commonWideString);
  4888.     commonWideString := SysAllocStringLen(nil, len);
  4889.     commonWideString[MultiByteToWideChar(codePage, 0, PChar(source), -1, commonWideString, len)] := #0;
  4890.     Result := commonWideString;
  4891. {$ENDIF}
  4892.   end;
  4893. end;
  4894.  
  4895. function IvStrLen(const str: String; codePage: Integer): Integer;
  4896. begin
  4897.   Result := MultiByteToWideChar(codePage, 0, PChar(str), -1, nil, 0) - 1;
  4898. end;
  4899.  
  4900. function IvWStrPCopy(dest: PWideChar; const source: TIvWideString): PWideChar;
  4901. var
  4902.   i, len: Integer;
  4903. begin
  4904.   Result := dest;
  4905. {$IFDEF IVWIDE}
  4906.   len := Length(source);
  4907.   for i := 1 to len do
  4908. {$ELSE}
  4909.   len := SysStringLen(source);
  4910.   for i := 0 to len - 1 do
  4911. {$ENDIF}
  4912.   begin
  4913.     dest^ := source[i];
  4914.     Inc(dest);
  4915.   end;
  4916.   dest^ := Chr(0);
  4917. end;
  4918.  
  4919. function IvSetKeyboardLayout(langId: Integer): HKL;
  4920. var
  4921.   i, count, tempLangId: Integer;
  4922.   kls: PHLK;
  4923.   kl: HKL;
  4924. begin
  4925.   kls := nil;
  4926.   count := GetKeyboardLayoutList(0, kls^);
  4927.   kls := AllocMem(count*Sizeof(HKL));
  4928.   count := GetKeyboardLayoutList(count, kls^);
  4929.  
  4930.   { Tries exact match }
  4931.  
  4932.   for i := 0 to count - 1 do
  4933.   begin
  4934.     kl := PHLK(PChar(kls) + i*Sizeof(HKL))^;
  4935.     tempLangId := kl and $FF;
  4936.     if tempLangId = langId then
  4937.     begin
  4938.       Result := ActivateKeyboardLayout(kl, 0);
  4939.       Exit;
  4940.     end;
  4941.   end;
  4942.  
  4943.   { Tries neutral match }
  4944.  
  4945.   langId := IvMakeLangId(IvGetPrimaryFromLocale(langId), SUBLANG_NEUTRAL);
  4946.   for i := 0 to count - 1 do
  4947.   begin
  4948.     kl := PHLK(PChar(kls) + i*Sizeof(HKL))^;
  4949.     tempLangId := kl and $FF;
  4950.     if tempLangId = langId then
  4951.     begin
  4952.       Result := ActivateKeyboardLayout(kl, 0);
  4953.       Exit;
  4954.     end;
  4955.   end;
  4956.  
  4957.   Result := IvResetKeyboardLayout;
  4958. end;
  4959.  
  4960. function IvResetKeyboardLayout: HKL;
  4961. begin
  4962.   Result := ActivateKeyboardLayout(KeyboardLayout, 0);
  4963. end;
  4964. {$ENDIF}
  4965.  
  4966. {$IFDEF WIN32}
  4967. const
  4968.   OLEAUT = 'oleaut32.dll';
  4969.  
  4970. function SysAllocString; external OLEAUT name 'SysAllocString';
  4971. function SysAllocStringLen; external OLEAUT name 'SysAllocStringLen';
  4972. function SysReAllocStringLen; external OLEAUT name 'SysReAllocStringLen';
  4973. procedure SysFreeString; external OLEAUT name 'SysFreeString';
  4974. function SysStringLen; external OLEAUT name 'SysStringLen';
  4975. {$ENDIF}
  4976.  
  4977. function IsDefaultDictionaryOpen: Boolean;
  4978. begin
  4979.   Result := (Dictionaries.Count >= 1) and (Dictionaries[0].IsOpen);
  4980. end;
  4981.  
  4982. {$IFDEF IVWIDE}
  4983. class procedure TIvDictionary.HandleException(sender: TObject; e: Exception);
  4984. var
  4985.   msg: String;
  4986. begin
  4987.   // Translates the exception
  4988.  
  4989.   msg := e.Message;
  4990.   if IsDefaultDictionaryOpen then
  4991.     msg := GetDefaultDictionary.Translate(msg);
  4992.  
  4993.   if (msg <> '') and (AnsiLastChar(msg) > '.') then
  4994.     msg := msg + '.';
  4995.  
  4996.   // Shows it
  4997.  
  4998.   MessageDlg(msg, mtError, [mbOK], 0);
  4999. end;
  5000.  
  5001. function TranslateLoadResString(resStringRec: PResStringRec): String;
  5002. var
  5003.   buffer: array[0..1023] of Char;
  5004. begin
  5005.   // Loads the resource string
  5006.  
  5007.   if resStringRec <> nil then
  5008.   begin
  5009.   {$IFDEF IVBIDI}
  5010.     if resStringRec.Identifier < 64*1024 then
  5011.   {$ENDIF}
  5012.     begin
  5013.       SetString(
  5014.         Result,
  5015.         buffer,
  5016.         LoadString(
  5017.           FindResourceHInstance(resStringRec.Module^),
  5018.           resStringRec.Identifier,
  5019.           buffer,
  5020.           SizeOf(buffer)));
  5021.     end
  5022.   {$IFDEF IVBIDI}
  5023.     else
  5024.       Result := PChar(resStringRec.Identifier);
  5025.   {$ENDIF}
  5026.   end;
  5027.  
  5028.   // Translates the string
  5029.  
  5030.   if (Result <> '') and resStrTranslationEnabled and IsDefaultDictionaryOpen then
  5031.   begin
  5032.     resStrTranslationEnabled := False;
  5033.     Result := GetDefaultDictionary.Translate(Result);
  5034.     resStrTranslationEnabled := True;
  5035.   end;
  5036. end;
  5037.  
  5038. function IvLoadResString(resStringRec: PResStringRec): String;
  5039. asm
  5040.   PUSH  EBP
  5041.   MOV   EBP, ESP
  5042.   ADD   ESP, $-8
  5043.   MOV   [EBP-$8], EDX
  5044.   MOV   [EBP-$4], EAX
  5045.   MOV   EDX, [EBP-$8]
  5046.   MOV   EAX, [EBP-$4]
  5047.   MOV   ECX, OFFSET Addr(TranslateLoadResString)-$1
  5048.   CALL  ECX
  5049.   MOV   ESP,EBP
  5050.   POP   EBP
  5051. end;
  5052.  
  5053. type
  5054.   TMenuKeyCap = (mkcBkSp, mkcTab, mkcEsc, mkcEnter, mkcSpace, mkcPgUp,
  5055.     mkcPgDn, mkcEnd, mkcHome, mkcLeft, mkcUp, mkcRight, mkcDown, mkcIns,
  5056.     mkcDel, mkcShift, mkcCtrl, mkcAlt);
  5057.  
  5058. function GetTranslatedMenuKeyCaps(value: TMenuKeyCap): String;
  5059. begin
  5060.   case value of
  5061.     mkcBkSp: Result := SmkcBkSp;
  5062.     mkcTab: Result := SmkcTab;
  5063.     mkcEsc: Result := SmkcEsc;
  5064.     mkcEnter: Result := SmkcEnter;
  5065.     mkcSpace: Result := SmkcSpace;
  5066.     mkcPgUp: Result := SmkcPgUp;
  5067.     mkcPgDn: Result := SmkcPgDn;
  5068.     mkcEnd: Result := SmkcEnd;
  5069.     mkcHome: Result := SmkcHome;
  5070.     mkcLeft: Result := SmkcLeft;
  5071.     mkcUp: Result := SmkcUp;
  5072.     mkcRight: Result := SmkcRight;
  5073.     mkcDown: Result := SmkcDown;
  5074.     mkcIns: Result := SmkcIns;
  5075.     mkcDel: Result := SmkcDel;
  5076.     mkcShift: Result := SmkcShift;
  5077.     mkcCtrl: Result := SmkcCtrl;
  5078.     mkcAlt: Result := SmkcAlt;
  5079.   end;
  5080.  
  5081.   if IsDefaultDictionaryOpen then
  5082.     Result := GetDefaultDictionary.Translate(Result);
  5083. end;
  5084.  
  5085. function GetSpecialName(shortCut: TShortCut): String;
  5086. var
  5087.   ScanCode: Integer;
  5088.   KeyName: array[0..255] of Char;
  5089. begin
  5090.   Result := '';
  5091.   ScanCode := MapVirtualKey(WordRec(ShortCut).Lo, 0) shl 16;
  5092.   if ScanCode <> 0 then
  5093.   begin
  5094.     GetKeyNameText(ScanCode, KeyName, SizeOf(KeyName));
  5095.     if (KeyName[1] = #0) and (KeyName[0] <> #0) then
  5096.       GetSpecialName := KeyName;
  5097.   end;
  5098. end;
  5099.  
  5100. function TranslateShortCutToText(ShortCut: TShortCut): String;
  5101. var
  5102.   Name: string;
  5103. begin
  5104.   case WordRec(ShortCut).Lo of
  5105.     $08, $09:
  5106.       Name := GetTranslatedMenuKeyCaps(TMenuKeyCap(Ord(mkcBkSp) + WordRec(ShortCut).Lo - $08));
  5107.  
  5108.     $0D:
  5109.       Name := GetTranslatedMenuKeyCaps(mkcEnter);
  5110.  
  5111.     $1B:
  5112.       Name := GetTranslatedMenuKeyCaps(mkcEsc);
  5113.  
  5114.     $20..$28:
  5115.       Name := GetTranslatedMenuKeyCaps(TMenuKeyCap(Ord(mkcSpace) + WordRec(ShortCut).Lo - $20));
  5116.  
  5117.     $2D..$2E:
  5118.       Name := GetTranslatedMenuKeyCaps(TMenuKeyCap(Ord(mkcIns) + WordRec(ShortCut).Lo - $2D));
  5119.  
  5120.     $30..$39:
  5121.       Name := Chr(WordRec(ShortCut).Lo - $30 + Ord('0'));
  5122.  
  5123.     $41..$5A:
  5124.       Name := Chr(WordRec(ShortCut).Lo - $41 + Ord('A'));
  5125.  
  5126.     $60..$69:
  5127.       Name := Chr(WordRec(ShortCut).Lo - $60 + Ord('0'));
  5128.  
  5129.     $70..$87:
  5130.       Name := 'F' + IntToStr(WordRec(ShortCut).Lo - $6F);
  5131.   else
  5132.     Name := GetSpecialName(ShortCut);
  5133.   end;
  5134.  
  5135.   if Name <> '' then
  5136.   begin
  5137.     Result := '';
  5138.     if ShortCut and scShift <> 0 then
  5139.       Result := Result + GetTranslatedMenuKeyCaps(mkcShift);
  5140.  
  5141.     if ShortCut and scCtrl <> 0 then
  5142.       Result := Result + GetTranslatedMenuKeyCaps(mkcCtrl);
  5143.  
  5144.     if ShortCut and scAlt <> 0 then
  5145.       Result := Result + GetTranslatedMenuKeyCaps(mkcAlt);
  5146.  
  5147.     Result := Result + Name;
  5148.   end
  5149.   else
  5150.     Result := '';
  5151. end;
  5152.  
  5153. function IvShortCutToText(ShortCut: TShortCut): String;
  5154. asm
  5155.   PUSH  EBP
  5156.   MOV   EBP, ESP
  5157.   ADD   ESP, $-8
  5158.   MOV   [EBP-$8], EDX
  5159.   MOV   [EBP-$4], EAX
  5160.   MOV   EDX, [EBP-$8]
  5161.   MOV   EAX, [EBP-$4]
  5162.   MOV   ECX, OFFSET Addr(TranslateShortCutToText)-$1
  5163.   CALL  ECX
  5164.   MOV   ESP,EBP
  5165.   POP   EBP
  5166. end;
  5167. {$ENDIF}
  5168.  
  5169. {$IFDEF WIN32}
  5170. initialization
  5171.   euroUsage := iveNormal;
  5172.   KeyboardLayout := GetKeyboardLayout(0);
  5173.   Dictionaries := TIvDictionaries.Create;
  5174.   {$IFDEF IVWIDE}
  5175.   resStrTranslationEnabled := True;
  5176.   loadResStringChanged := False;
  5177.   {$ENDIF}
  5178. finalization
  5179.   Dictionaries.Free;
  5180.   Dictionaries := nil;
  5181. {$ELSE}
  5182. begin
  5183.   euroUsage := iveNormal;
  5184.   Dictionaries := TIvDictionaries.Create;
  5185.   userDefaultLCID := 0;
  5186. {$ENDIF}
  5187. end.
  5188.  
  5189.